am0251

謝謝Hsieh大大的出手相助......可是還是不行.........,可以再告訴我,我又錯在哪裡呢?萬二分感謝!

1. Private Sub Start_Click()
   
2. 
   
3. Dim x As Integer, y As Integer, z As Integer, S1 As Integer, S2 As Integer, myRowCount As Integer
   
4. Dim ShipDate As Double
   
5. Dim ItemName As String
   
6. 
   
7. z = 2
   
8. 
   
9. myRowCount = Range("A1").CurrentRegion.Rows.Count
   
10. 
    
11. ShipDate = Format(Calendar1.Value, "d-mmm-yy")
    
12. 
    
13. For i = 2 To myRowCount
    
14. 
    
15. ItemName = Worksheets("Sheet1").Range("A" & z).Value
    
16. 
    
17. x = Application.Match(ItemName, Sheet2.Range("A1:A" & myRowCount), 0)
    
18. y = Application.Match(ShipDate, Sheet2.[B1:AF1], 0)
    
19. 
    
20. S1 = Workbooks("Book1").Worksheets("Sheet2").Cells(x, y).Value
    
21. S2 = Workbooks("Book1").Worksheets("Sheet1").Cells(z, 2).Value
    
22. 
    
23. S1 = S1 + S2
    
24. 
    
25. z = z + 1
    
26. 
    
27. Next i
    
28. 
    
29. Unload Me
    
30. 
    
31. MsgBox "Done"
    
32. 
    
33. End Sub

複製代碼

Hsieh

回復 21# am0251
既然已經宣告成DOUBLE型態
ShipDate = Format(Calendar1.Value, "d-mmm-yy")
這樣又轉成了字串，當然型態不符
直接ShipDate =Calendar1.Value
只針對語法解釋，其他不了解你的目的是甚麼?無法給你任何意見

am0251

是這樣的,我的設計是想把"SHEET1"的資料按日期,名稱,每頁的名稱,放到對應的位置,可惜功力不夠,千差萬錯,希望各位高手指點一下~~謝謝!! test.rar (30.27 KB)

下載次數: 18

2011-6-27 14:03

Hsieh

回復 23# am0251

1. Private Sub Start_Click()
   
2. Dim mydate#
   
3. mydate = Calendar1.Value
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. With Sheet1
   
6. sh = .[E1] '工作表名稱
   
7. For Each a In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
   
8.    d(a.Value) = a.Offset(, 1).Value
   
9. Next
   
10. With Sheets(sh)
    
11.   k = Application.Match(mydate, .Rows(1), 0)
    
12.    If IsError(k) Then MsgBox "The day is not find!": Exit Sub
    
13.       For Each a In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
    
14.          .Cells(a.Row, k) = d(a.Value)
    
15.       Next
    
16. End With
    
17. End With
    
18. Unload Me
    
19. MsgBox "Done"
    
20. End Sub

複製代碼

am0251

完美的解決~~!!不過可以再教我多一個功能嗎?就是想每次把資料送到目標位置時不用"="而是相加,例如,"SHEET1" 的"AAA"的資料是"1",但目標位置本來就有"2"的話,運作之後就可以變成"3",那就是我的目了..謝謝!!

Hsieh

.Cells(a.Row, k) = .Cells(a.Row, k) +d(a.Value)

ten999

可查看excel說明內公式查詢

Happkkevin

看了上面的帖子，對於函數使用於VBA 還是一知半解
不知可否將常用的函數組合運用於 VBA 呈現，配合自定義函數使用
但應該是對於資料形態還不了解，再加上函數的寫法更是剛用
所以寫了一個應該是錯誤不少，改了數次都亂了譜
如附件，希望有先進可以協助一下看是否可行
函數組合為
=IF(ISNA(VLOOKUP($A2,設備清單!$A$1:$B$20,MATCH(D$1,設備清單!A$1:B$1,0),0)),"無設備資料",(VLOOKUP($A2,設備清單!$A$1:$B$20,MATCH(D$1,設備清單!A$1:B$1,0),0)))
希望呈現
=vlmatch($A2,E$1,無設備資料,設備清單!$A$1:$B$20,設備清單!$A$1:$B$1)
vlmatch 為自定義函數，只需輸入 $A2,E$1,無設備資料,設備清單!$A$1:$B$20,設備清單!$A$1:$B$1即可
改了數次，最後錯誤，寫了如下

1. Public Function VLMatch(tt$, KK$, NN$, DALL As Range, dt As Range) As String
   
2. 
   
3. Dim i%, j$, k As Boolean
   
4. i = Evaluate("Match(kk, dt, 0)")
   
5. j = Evaluate("VLookup(tt, DALL, i, 0)")
   
6. k = Evaluate("IsNA(j)")
   
7. If k = False Then
   
8.   VLMatch = NN
   
9.   Else
   
10.   VLMatch = j
    
11.   End If
    
12. 
    
13. End Function

複製代碼

自定義函數 VLOOK+Match.rar (108.68 KB)

下載次數: 11

2011-7-17 01:26

GBKEE

回復 28# Happkkevin

1. Public Function VLMatch(tt$, KK$, NN$, DALL As Range, dt As Range) As String
   
2.     'Match  找到值則傳回數字,沒找到值則傳回錯誤值
   
3.     'VLookup   找到傳回字串,沒找到傳回錯誤值
   
4.     Dim i As Variant, j As Variant  '變數需設定為Variant資料型態
   
5.     'Variant資料型態是所有沒被明確宣告為任一其他型態
   
6.     i = Application.Match(KK, dt, 0)  'vba中使用工作表函數->  Application.工作表函數
   
7.     '請看vba中可使用的工作表函數
   
8.     j = Application.VLookup(tt, DALL, i, 0)
   
9.     '***   Evaluate("VLookup(tt, DALL, i, 0)")=[VLookup(tt, DALL, i, 0)]
   
10.     '不接受變數 tt, DALL, i   ***
    
11.     If IsError(j) Then   'j傳回錯誤值
    
12.         VLMatch = NN
    
13.     Else:    'j傳回字串
    
14.         If j = "" Then VLMatch = NN Else VLMatch = j
    
15.     End If
    
16. End Function

複製代碼

Happkkevin

回復  Happkkevin
GBKEE 發表於 2011-7-17 08:45

GBKEE 版大，真的是太厲害囉
每每我花了許久時間修正只要經過此處先進的指導
不只問題解決，更讓我學到許多
至於VBA可用函數之前我沒有確認只是 if 發生問題才處理
說明中 我的軟體關於 vlookup 與 match 沒有說明，但我想應該是與函數相同
感謝你的指導
修正為你的語法加上修正 NN輸入""即符合我的需求
=vlmatch($A2,E$1,"無設備資料",設備清單!$A$1:$B$20,設備清單!$A$1:$B$1)