Excel VBA匹配還是查找？

Question

我試過了，我真的試過了！我有兩張「拖欠」和「趨勢」。下面是一個用於保存單詞的圖像： Intended tables

這個想法是讓腳本循環通過工作表趨勢的A列中的（現有）記錄，在工作表拖欠的A列中找到匹配項。然後使用該匹配，將數字欄（拖欠表）中的相應金額過帳到趨勢圖背面插入列中的相應單元格（通過移動現有記錄1xToRight。

我試圖學習VBA，因爲我我曾經使用過MATCH，發現我可以做所有事情，除了將相應的價值從拖欠款轉移到趨勢之外

在這個階段之後還有其他的事情要做，但我不想問對於完整的腳本，否則我什麼都不會學習！

Answer 1

下面是我最近使用過的類似代碼的一個小片段 不是你的問題最優化的代碼，但它應該可以幫助你「看」解決方案。

Dim rngStr As String 'range declaration 
Dim currentRowIndex As Integer 'used to store the rowindex of certain searchvalues 
Dim searchStr As String 'word to search 
Dim ws As Worksheet 

'Set searchcolumn = A 
rngStr = "A:A" 
searchstring = "Cellvalue of cell in loop" 
currentRowIndex = SearchInRange(ws, rngStr, searchStr) 

If currentRowIndex <> 0 Then 
    'searchstr was found 
    Worksheets("TrendsSheet").Cells(rowIndex, ColIndex).value = Worksheets("ArrearsSheet").Cells(currentRowIndex, ColIndexOfValueYouWant).value 
End If 



Private Function SearchInRange(ws As Worksheet, rng As String, searchstring As String) As Integer 
    'return the rowindex of the first found value in a specific range 
    With ws.Range(rng) 
     Set c = .Find(searchstring, LookIn:=xlValues) 
     If Not c Is Nothing Then 
      SearchInRange = c 'searchstring found 
     Else 
      SearchInRange = 0 'searchString not found 
     End If 
    End With 
End Function 

Answer 2

從我明白我已經取得了一些代碼，做你所要求的

Sub Transfer() 
Dim Wks1 As Excel.Worksheet 
Dim Wks2 As Excel.Worksheet 
Dim copyCell As Long 
Dim pasteCell As Long 
Dim RowMatched As Long 
Dim SearchItem As Double 
Dim NumberOfEntries As Long 
Dim RowMoved As Boolean 
Set Wks1 = Worksheets("Sheet1") '<== One worksheet 
Set Wks2 = Worksheets("Sheet2") '<== Another worksheet 
NumberOfEntries = Application.WorksheetFunction.CountA(Wks2.Range("A:A")) '<=== Finds the number of entries 
RowMoved = False '<===== Checks if row has been inserted 
For x = 2 To NumberOfEntries '<==== For all your entries 
SearchItem = Wks2.Cells(x, 1) '<=== What it is looking for 
On Error Resume Next 
    RowMatched = Application.WorksheetFunction.Match(SearchItem, Wks1.Range("A:A"), 0) '<== Match Items 
On Error GoTo 0 
If RowMatched <> 0 Then '<=== If found 
    If RowMoved = False Then '<== If no column has been added yet 
     Wks2.Range("E:E").EntireColumn.Insert '<=== Add new row in column E 
    End If 
    RowMoved = True '<=== Set row moved to true to indicate inserted column 
    Wks2.Cells(x, 5) = Wks1.Cells(RowMatched, 5) '<==== Copy Cell values 
End If 
Next x 



End Sub 

名稱什麼都你叫他們，並把這個在一個新的模塊工作表。如果需要，您也可以使用列號。讓我知道如果你需要任何東西:)