为所有消息ID写单个函数

Iam新的Excel VBA，我开始写一个代码，执行得很好，但我需要一个build议如何编写一个函数，我不需要编写代码的所有“ID”。

例如：我有主工作表有ID（1000x，10000，2000X，20000）。 我想只search带有数字的ID而不是字母表，并将其与具有相同ID的另一个工作表进行比较，如果获得相应的ID第三列数据并将它们全部封装在主工作表中。

我在Coloumn A中拥有所有ID（10000,20000）的主工作表（“Tabelle1”），我想要ID 10000的B列中的ID为10000的信息。有时我有10000次四次。 要将信息粘贴到另一个工作表（“Test_2”），我想收集所有的10000和corrosponding数据。

Sub Update() If MsgBox("Are you sure that you wish to Update New Measurement ?", vbYesNo, "Confirm") = vbYes Then Dim erow As Long, erow1 As Long, i As Long erow1 = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To erow1 If Sheets("Tabelle1").Cells(i, 2) <> "10000" Then Sheets("Tabelle1").Range(Sheets("Tabelle1").Cells(i, 1), Sheets("Tabelle1").Cells(i, 2)).Copy Sheets("Test_2").Activate erow = Sheets("Test_2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row ActiveSheet.Paste Destination:=Sheets("Test_2").Range(Cells(erow, 1), Cells(erow, 2)) Sheets("Test_2").Activate End If Next i Application.CutCopyMode = False For i = 1 To erow Totalstrings = Totalstrings & Cells(i, 2) & "" + vbCrLf Next i Totalstrings = Left(Totalstrings, Len(Totalstrings) - 1) Range("C5") = Totalstrings Range("C5").Select Selection.Copy Sheets("BSM_STF_iO").Select Range("C5").Select ActiveSheet.Paste MsgBox "New measurements have been Updated !" End If End Sub 

例

在BSM：STM：IO

AB
ID
1000X
10000
10001
…

在Tabelle1
公元前
ID
1000 abc
1000 xyz
10001 lmn
2000年def
“我只想比较”BSM：STM：Io“和”tabelle1“的数字。 例如取“BSM_STM_io”的第一个值10000与tabele比较，取“tablle1”中相应的Coloumn“C”的值，并将其放入BSM_STM的1000中的单个单元格：Io

• A，B，C在工作表中是coloumn

在这里input图像说明

Answer 1

让我们假设工作表“BSM_STF_iO”包含以A2开头的A列中的ID信息，并且工作表Tabelle1包含从B2开始的B列（例如：列B：ID，列C：收集的信息）中所需的关键信息。 下面的代码将包含内容并写入BSM_STF_iO表单。

 Sub test1() Worksheets("BSM_STF_iO").Select LastRow = Range("A" & Rows.Count).End(xlUp).Row For i = 2 To LastRow a = onlyDigits(Range("A" & i).Value) With Worksheets("Tabelle1") destlastrow = .Range("B" & Rows.Count).End(xlUp).Row For j = 2 To destlastrow If a = Trim(.Range("B" & j).Value) Then If out <> "" Then out = out & ", " & .Range("C" & j).Value Else out = .Range("C" & j).Value End If End If Next j Cells(i, 2) = out out = "" End With Next i End Sub 

和下面的函数采取如何从string中find数字？

 Function onlyDigits(s As String) As String Dim retval As String Dim i As Integer retval = "" For i = 1 To Len(s) If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then retval = retval + Mid(s, i, 1) End If Next onlyDigits = retval End Function