Excel VBA匹配还是查找？

Question

I've tried, I've really tried!! I have two sheets "arrears" and "trends". Here's an image to save loads of words: Intended tables

The idea is for a script to loop though (existing) records in column A of sheet Trends, Find a match in column A of sheet Arrears. Then with that match, post to corresponding amount from the figure column (arrears sheet) into the corresponding cell in the insert column back on the trend sheet (by moving existing records 1xToRight.

I'm trying to learn VBA as I go and have had loads of attempts. I was using MATCH and found that I could do everything except transfer the corresponding values from arrears to trends.

There is additional stuff to do after this stage but I don't want to ask for the full script otherwise I'll learn nothing!

Answer 1

a small snippet below of similar code I've used recently Not the most optimsed code for your problem, but it should help you 'see' the solution imo.

 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

From what I have understood I have made some code that does what you are asking for

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

Name the worksheets what ever you have called them and put this in a new module. You can also mess around with the column numbers if you need to. Let me know if you need anything else :)