Tüm mesaj tipi için yazılacak tek fonksiyon

Question

Iam new to Excel VBA, iyi çalıştırılan bir kod yazmaya başladım, ama tüm "ID" için kod yazmam gerekmediği bir işlevi nasıl yazacağım bir öneriye ihtiyacım var ".

Örneğin: Kimlik (1000x, 10000, 2000X, 20000) olan ana çalışma sayfam var. Sadece alfabede olmayan bir numarayla arama yapmak ve aynı kimlik numarasına sahip başka bir çalışma sayfasıyla karşılaştırmak istiyorum, eğer o zaman kimlik bilgisi 3. sütun verisi alırsa ve hepsini ana çalışma sayfasına sığdırırsa.

Tüm A numaralarına (1000020000) A Sütununda sahip olduğum ana çalışma sayfam ("Tabelle1") var, ID 10000'ün ID 10000'ün B sütununda olmasını istiyorum. Bazı zamanlarda dört kez 10000'üm var. Başka bir çalışma sayfasına ("Test_2") infomrasyon yapıştırmak istiyorum, ben tüm 10000 ve corrosponding veri toplamak istiyorum.

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 

Örnek BSM olarak

: STM: IO

A B
İD
1000X
...

Tab elle1
B C
kimliği
1000 abc
1000 xyz
10001 LMN def
"BSM: STM: Io" " Ben sadece rakamı karşılaştırmak istiyorum" "tabelle1" ile. Io

• A, B, Örnek "tablle1" olarak Kolon "C" y¨onelik değerini alır tabele ile karşılaştırmak ve BSM_STM 1000 yılında tek bir hücreye koydu "BSM_STM_io" ilk değeri 10000 almak Cı

enter image description here

Answer 1

çalışma varsayalım çalışma sayfasına Kolon olan "BSM_STF_iO" (A2 ve çalışma Tabelle1 ile başlayan bir sütunda kimlik bilgileri B2 itibaren B sütun gerekli concaetenation bilgileri içerir içeren ör .: C olumn B: Kimlikler, Sütun C: concaetenate'e bilgi). Kodun altında içerikler kontamine olacak ve BSM_STF_iO sayfasında yazılacaktır.

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 

ve işlevi aşağıda

sütun Tabelle1 veya başka bir tabaka B'nin aynı levha ile bir ID arama 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