Vba 搜索并更新到单个单元格中

我刚接触VBA excel，一周大。我对C语言知之甚少，因此我创建了一个程序

任务是“在一张excel工作表（1）中搜索一个特定的数字，并在另一张工作表（2）中进行比较，获取相应的列数据，将信息浓缩到工作表（1）的一个单元格中

我试过了，但是我无法完成这个过程。我需要一个有价值的建议来修复我的代码

我的代码：

Sub test1()
Dim iComp
Worksheets("BSM_STF_iO").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow

      a = onlyDigits(Range("A" & i).Value)
       If InStr(a, "T") Then
       Else

     Worksheets("Tabelle1").Select
        destlastrow = Range("B" & Rows.Count).End(xlUp).Row
        For j = 2 To destlastrow
         b = onlyDigits(Range("B" & j).Value)
          iComp = StrComp(a, b, vbBinaryCompare)
        Select Case iComp
       Case 0
Sheets("Tabelle1").Range(Sheets("Tabelle1").Cells(j, 3), Sheets("Tabelle1").Cells(j, 4)).Copy
Sheets("Tabelle1").Activate
erow = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Sheets("Tabelle1").Range(Cells(erow, 8), Cells(erow, 9))
Sheets("BSM_STF_iO").Activate
End Select
        Next j


    End If

Next i
End Sub
Function onlyDigits(s As String) As String
    Dim retval As String
    Dim i As Integer
    retval = ""
              retval = s
      onlyDigits = retval
End Function

例如：

我需要将“表1”工作表信息“10000”中的所有信息放入“BSM_STF_io”10000

看看这是否有帮助（我删除了

.Activate/。选择
部分）：

在您的原始代码中，有时您正确地给出了该范围的工作表，但有时不正确（您应该使用
工作表（“任意”）.Rows.Count
）。这将很有希望加强它，并对您有效。
我建议您通读一遍，因为使用它们可能会导致一些意外行为。您当前的代码是否有错误？它不需要做什么？我无法将值连接到单个单元格中可能重复的值，但我在此处修改了代码，我从thereya获得了代码，代码比ks，如何在递增的列中粘贴“tabWs”，并将该值连接到B3行中仅ID为“10000”的“Bsm_Stm_io”
Sub test1()
Dim iComp
Dim bsmWS As Worksheet, tabWS As Worksheet

Set bsmWS = Sheets("BSM_STF_iO")
Set tabWS = Sheets("Tabelle1")

LastRow = bsmWS.Range("A" & bsmWS.Rows.Count).End(xlUp).Row
For i = 2 To LastRow
    a = onlyDigits(bsmWS.Range("A" & i).Value)
    If InStr(a, "T") Then
    ' do something?
    Else
        destlastrow = tabWS.Range("B" & tabWS.Rows.Count).End(xlUp).Row
        For j = 2 To destlastrow
            b = onlyDigits(tabWS.Range("B" & j).Value)
            iComp = StrComp(a, b, vbBinaryCompare)
            Select Case iComp
            Case 0
                With tabWS
                    erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                    .Range(.Cells(j, 3), .Cells(j, 4)).Copy .Range(.Cells(erow, 8), .Cells(erow, 9))
                End With     'tabWS
            End Select
        Next j
    End If

Next i
End Sub