Question

我是VBA excel的新手，一周大了。我对C知之甚少，因为我创建了一个程序。

任务是＆＃34;在一个Excel工作表（1）中搜索特定数字并在另一个工作表（2）中进行比较，获取相应的coloumn数据，将信息合并到工作表（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

示例：

我需要提供来自＆＃34; tabelle1＆＃34;的所有信息。＆＃34; 10000＆＃34;的工作表信息到＆＃34; BSM_STF_io＆＃34; 10000

BSM_STF_io
Tabellle1

Answer 1

看看这是否有帮助（我删除了.Activate/.Select部分）：

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

在您的原始代码中，有时您正确地给出了范围的工作表，但有时则没有（您也应该使用Sheets("whatever").Rows.Count）。这有望收紧并为你工作。

搜索并更新到单个单元格

1 个答案: