すべてのメッセージIDを書き込むための単一の関数

Question

Excel VBAの初心者ですが、私はコードを書き始めましたが、うまく実行されましたが、私はすべての "IDのコードを書く必要はありません"

例： ID（1000x、10000、2000X、20000）のメインワークシートがあります。 アルファベットではない番号のIDのみを検索し、IDが同じである別のワークシートと比較したい場合は、IDの第3列のデータを取得してすべてのデータをメインワークシートに照会します。

Coloumn AのすべてのID（10000,20000）を持つメインワークシート（「Tabelle1」）があります。ID 10000のB列にID 10000の情報が必要です。インフォメーションを別のワークシート（「Test_2」）に貼りたいので、10000と腐食性のデータをすべて集めたい。 BSMで

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 

例

：STM：タブのIO

B
ID
1000X
...

"tabelle1" と "：：STMイオBSM" DEF elle1
B C
ID
1000年ABC
1000年のxyz
10001 LMN
" は私からのみの数字を比較したいです"。 、イオ

• A、B：例は、「tablle1」にColoumn「C」をcorrospondingの値をとるtabeleと比較しBSM_STM 1000において単一のセルに入れて「BSM_STM_io」から最初の値10000をとりますCワークシート

enter image description here

Answer 1

にcoloumnているワークシートをとることができます「BSM_STF_iO」はA2で始まる列にID情報が含まれており、ワークシートTabelle1が（B2から始まるB欄に必要なconcaetenation情報を含みます例：C列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 

と同じTabelle1におけるBのシートまたは他のシートでカラムA IDを検索How to find numbers from a string?

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