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

198188

帖子: 582
主題: 75
精華: 0
積分: 682
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2026-4-13

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

超級版主 Rank: 8 Rank: 8

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

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

13^#

發表於 2012-11-13 20:27 | 只看該作者

回復 11# 198188

Sub nn()
Dim Ay(), Rng As Range, m$, A As Range, r&, Ar
With Sheets("Sheet1") '改成正確工作表名稱
If Application.CountIf(.Range("B:B"), "JPM") > 0 Then '判斷B欄是否有JPM
.Range("B:B").Replace "JPM", "=1/0", xlWhole '將JPM以公式取代
Set Rng = .Range("B:B").SpecialCells(xlCellTypeFormulas, 16) '將公式為錯誤值的儲存格設為變數
Rng.Value = "JPM" '將公式還原成JPM
For Each A In Rng
r = A.Row
m = .Cells(r, "U") & "、" & .Cells(r, "V") & "、" & .Cells(r, "W")
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, _
.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)
ReDim Preserve Ay(s)
Ay(s) = Ar
s = s + 1
Next
Sheets("JPM").UsedRange.Offset(1).Clear '將JPM工作表內容清空
If s > 0 Then Sheets("JPM").[A2].Resize(s, UBound(Ar) + 1) = Application.Transpose(Application.Transpose(Ay)) '將陣列寫到JPM工作表
End If
End With
End Sub

複製代碼

Match函數如果找不到符合資料就會出錯

學海無涯_不恥下問

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 582
主題: 75
精華: 0
積分: 682
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2026-4-13

12^#

發表於 2012-11-13 18:18 | 只看該作者

回復 10# Hsieh

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

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 582
主題: 75
精華: 0
積分: 682
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2026-4-13

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

超級版主 Rank: 8 Rank: 8

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

2025年全勤獎章 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

Sub nn()
With Sheets("Sheet1") '改成正確工作表名稱
If Application.CountIf(.Range("B:B"), "JPM") > 0 Then '判斷B欄是否有JPM
.Range("B:B").Replace "JPM", "=1/0", xlWhole '將JPM以公式取代
Set Rng = .Range("B:B").SpecialCells(xlCellTypeFormulas, 16) '將公式為錯誤值的儲存格設為變數
Rng.Value = "JPM" '將公式還原成JPM
Sheets("JPM").UsedRange.Offset(1).Clear '將JPM工作表內容清空
Rng.EntireRow.Copy Sheets("JPM").[A2] '將B欄為JPM的列複製貼到JPM工作表
End If
End With
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

高中生 Rank: 3 Rank: 3

帖子: 582
主題: 75
精華: 0
積分: 682
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2026-4-13

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

超級版主 Rank: 8 Rank: 8

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

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

8^#

發表於 2012-11-13 14:10 | 只看該作者

回復 6# 198188

Sub nn()
With 工作表1
If Application.CountIf(.Range("B:B"), "JPM") > 0 Then '判斷B欄是否有JPM
.Range("B:B").Replace "JPM", "=1/0", xlWhole '將JPM以公式取代
Set Rng = .Range("B:B").SpecialCells(xlCellTypeFormulas, 16) '將公式為錯誤值的儲存格設為變數
Rng.Value = "JPM" '將公式還原成JPM
Sheets("JPM").UsedRange.Offset(1).Clear '將JPM工作表內容清空
Rng.EntireRow.Copy Sheets("JPM").[A2] '將B欄為JPM的列複製貼到JPM工作表
End If
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 582
主題: 75
精華: 0
積分: 682
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2026-4-13

7^#

發表於 2012-11-13 10:20 | 只看該作者

回復 5# c_c_lai

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

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 582
主題: 75
精華: 0
積分: 682
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2026-4-13

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

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

5^#

發表於 2012-11-13 07:52 | 只看該作者

回復 1# 198188
不知道這是否是你的需求？

Sub Test()
Sheets("JPM").Visible = False
End Sub
Sub Test2()
Sheets("JPM").Visible = True
End Sub

複製代碼

TOP

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]