Question

我已经尝试过，我已经尝试过!!我有两张床单＆＃34;欠款＆＃34;和＆＃34;趋势＆＃34;。这是一个用于保存大量单词的图像： Intended tables

我们的想法是让一个脚本循环通过（现有）工作表A列中的记录，在工作表欠费的A列中查找匹配项。然后使用该匹配，从图表列（欠款表）过帐到趋势表上的插入列中的相应单元格（通过移动现有记录1xToRight。

我正在尝试学习VBA，并且已经尝试了很多次尝试。我正在使用MATCH，发现我可以做任何事情，除了将相应的值从欠款转移到趋势。

在此阶段之后还有其他事情要做，但我不想要求完整的脚本，否则我什么都不会学到！

Answer 1

以下我最近使用过的类似代码的小片段对于您的问题，这不是最优化的代码，但它应该可以帮助您查看＆＃39;解决方案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

据我所知，我已经制作了一些符合你要求的代码

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

将工作表命名为您所称的工作表并将其放入新模块中。如果需要，您还可以使用列号。如果您还需要其他信息，请告诉我们。）

Excel VBA匹配还是查找？

2 个答案: