123
返回列表 上一主題 發帖

如何可以讓不是"JPM"不顯示出來，也不會留一行空格？

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
14# 跳轉到 »
發表於 2012-11-13 20:35 | 只看該作者
回復 10# Hsieh


    Sub sample()

Dim LastRec As Integer
Dim j As Integer
Dim i As Integer
Dim l As Integer
Dim data() As Range
l = 1
fs = "C:\Documents and Settings\USER\桌面\HK ETA update.xlsx"          這句出現error 執行階段錯誤'13'型態不符合！
Set wb = Workbooks.Open(fs)

Workbooks("outstanding payments").Worksheets("2012").Range("A1").Select 這
ActiveCell.End(xlDown).Select
     LastRec = ActiveCell.Row
     


For j = 1 To LastRec

i = Application.Match(Worksheets("2012").Cells(j, 1), wb.Sheets("香港&海防單").Range("A:A"), 0)


If Worksheets("2012").Cells(i, 4).Value <> wb.Sheets("香港&海防單").Cells(i, 12).Value Then

Worksheets("2012").Cells(i, 4).Value = wb.Sheets("香港&海防單").Cells(i, 2).Value
Worksheets("2012").Cells(i, 4).Interior.Color = RGB(255, 200, 255)
End If

Next j

wb.Close 0

End Sub

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
45  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-2-21 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
13#
發表於 2012-11-13 20:27 | 只看該作者
回復 11# 198188
  1. Sub nn()
  2. Dim Ay(), Rng As Range, m$, A As Range, r&, Ar
  3. With Sheets("Sheet1") '改成正確工作表名稱
  4. If Application.CountIf(.Range("B:B"), "JPM") > 0 Then '判斷B欄是否有JPM
  5. .Range("B:B").Replace "JPM", "=1/0", xlWhole '將JPM以公式取代
  6. Set Rng = .Range("B:B").SpecialCells(xlCellTypeFormulas, 16) '將公式為錯誤值的儲存格設為變數
  7. Rng.Value = "JPM" '將公式還原成JPM
  8. For Each A In Rng
  9. r = A.Row
  10. m = .Cells(r, "U") & "、" & .Cells(r, "V") & "、" & .Cells(r, "W")
  11. Ar = Array(.Cells(r, "S").Value, .Cells(r, "T").Value, .Cells(r, "C").Value, .Cells(r, "AA").Value, .Cells(r, "D").Value, .Cells(r, "AB").Value, _
  12. .Cells(r, "AC").Value, .Cells(r, "AD").Value, .Cells(r, "AE").Value, .Cells(r, "AF").Value, .Cells(r, "F").Value, m, .Cells(r, "X").Value, .Cells(r, "Y").Value, .Cells(r, "Z").Value)
  13. ReDim Preserve Ay(s)
  14. Ay(s) = Ar
  15. s = s + 1
  16. Next
  17. Sheets("JPM").UsedRange.Offset(1).Clear '將JPM工作表內容清空
  18. If s > 0 Then Sheets("JPM").[A2].Resize(s, UBound(Ar) + 1) = Application.Transpose(Application.Transpose(Ay)) '將陣列寫到JPM工作表
  19. End If
  20. End With
  21. End Sub
複製代碼
Match函數如果找不到符合資料就會出錯
學海無涯_不恥下問

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
12#
發表於 2012-11-13 18:18 | 只看該作者
回復 10# Hsieh


    未命名.rar (118.82 KB)
還是有錯誤

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
11#
發表於 2012-11-13 15:24 | 只看該作者
回復 10# Hsieh

結果.rar (198.35 KB)

可以將JPM 資料複製過去了，謝謝！
但是有沒有方法改變它們的位置，因為我不是要全部搬過去，和我想它們在A:F順序抄過去。
   
DATE        TRACKING NO        SO NO        MM        BUYER        PLANT        BOXES        CONTAINER NO        ORIGIN        ETD        ETA        DOCS LIST        REMARK        US ARRANGE PAYMENT ON        HK PICK UP ON

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
45  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-2-21 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 2012-11-13 15:12 | 只看該作者
本帖最後由 Hsieh 於 2012-11-13 15:13 編輯

回復 9# 198188
  1. Sub nn()
  2. With Sheets("Sheet1") '改成正確工作表名稱
  3. If Application.CountIf(.Range("B:B"), "JPM") > 0 Then '判斷B欄是否有JPM
  4. .Range("B:B").Replace "JPM", "=1/0", xlWhole '將JPM以公式取代
  5. Set Rng = .Range("B:B").SpecialCells(xlCellTypeFormulas, 16) '將公式為錯誤值的儲存格設為變數
  6. Rng.Value = "JPM" '將公式還原成JPM
  7. Sheets("JPM").UsedRange.Offset(1).Clear '將JPM工作表內容清空
  8. Rng.EntireRow.Copy Sheets("JPM").[A2] '將B欄為JPM的列複製貼到JPM工作表
  9. End If
  10. End With
  11. End Sub
複製代碼
問題二
開啟檔案
fs = "C:\user\destop\outstanding payment.xlsx"
Set wb = Workbooks.Open(fs)
For j=1 To ....
i = Application.Match(Sheet1.Cells(1, j), wb.Sheets("Sheet2").[A:A], 0)
...
...
...
Next
wb.Close 0
學海無涯_不恥下問

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
9#
發表於 2012-11-13 14:41 | 只看該作者
回復 8# Hsieh


result.rar (486.07 KB)

還是沒有顯示出來. JPM WORKSHEET空白一片~
另外想問
Sub sample()

Dim LastRec As Integer
Dim j As Integer
Dim i As Integer
Dim l As Integer
Dim data() As Range
l = 1

Worksheets("Sheet1").Range("A1").Select
ActiveCell.End(xlDown).Select
     LastRec = ActiveCell.Row
     

For j = 1 To LastRec

i = Application.Match(Sheet1.Cells(1, j), "C:\user\destop\[outstanding payment]Sheet2'!.Range("A:A"), 0) 我想讀取桌面另外一個excel的資料，這句是不是有問題？

If Sheet1.Cells(i, 2).Value <> Sheet2.Cells(i, 2).Value Then

Sheet1.Cells(i, 2).Value = Sheet2.Cells(i, 2).Value
Sheet1.Cells(i, 2).Interior.Color = RGB(255, 200, 255)
End If

Next j

End Sub

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
45  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-2-21 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2012-11-13 14:10 | 只看該作者
回復 6# 198188
  1. Sub nn()
  2. With 工作表1
  3. If Application.CountIf(.Range("B:B"), "JPM") > 0 Then '判斷B欄是否有JPM
  4. .Range("B:B").Replace "JPM", "=1/0", xlWhole '將JPM以公式取代
  5. Set Rng = .Range("B:B").SpecialCells(xlCellTypeFormulas, 16) '將公式為錯誤值的儲存格設為變數
  6. Rng.Value = "JPM" '將公式還原成JPM
  7. Sheets("JPM").UsedRange.Offset(1).Clear '將JPM工作表內容清空
  8. Rng.EntireRow.Copy Sheets("JPM").[A2] '將B欄為JPM的列複製貼到JPM工作表
  9. End If
  10. End With
  11. End Sub
複製代碼
學海無涯_不恥下問

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
7#
發表於 2012-11-13 10:20 | 只看該作者
回復 5# c_c_lai


    這個程式沒有反映，是否還欠缺一些資料？

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2024-11-19 
6#
發表於 2012-11-13 10:19 | 只看該作者
回復 4# Hsieh


    04.Set Rng = .Range("B:B").SpecialCells(xlCellTypeFormulas, 16) 出現error, 將我DATA BASE的 JPM轉成1/0,但在jpm worksheet內就沒有copy 資料過去！

另外JPM  worksheet的資料是順序將DATA BASE的 JPM資料抄過來，但擺位是不一樣

DATA BASE (SHEET1)
欄數由A :Z
ITEM NO / STATE / SO / BUYER / AGENT / ETA /RECEIVE DATE/ RECEIVE TRACKING NO/ RECEIVE OBL/RECEIVE OHC/RECEIVE OTHER DOCS/RECEIVE REMARK/SEND DATE/SEND TRACKING NO/ SEND OBL/SEND OHC/SEND OTHER DOCS/SEND REMARK/ JPM DATE/JPM REF NO/JPM OBL/JPM OHC/ JPM OTHER DOCS/JPM REMARK/JPM US ARRANGE PAYMENT ON/JPM HK PICK UP ON

JPM WORKSHEET (JPM)只顯示這些資料
欄數由A : G
JPM DATE / JPM REF NO / SO/JPM DOCS LIST(JPM OBL, JPM OHC, JPM OTHER DOCS 合併）/JPM REMARK/JPM US ARRANGE PAYMENT ON/JPM HK PICK UP ON

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
5#
發表於 2012-11-13 07:52 | 只看該作者
回復 1# 198188
不知道這是否是你的需求？
  1. Sub Test()
  2.     Sheets("JPM").Visible = False
  3. End Sub

  5. Sub Test2()
  6.     Sheets("JPM").Visible = True
  7. End Sub
複製代碼

TOP

        靜思自在 : 人的眼睛長在前面，只看到別人的缺點，絲毫看不到自己的缺點。
123
返回列表 上一主題