单一功能可写入所有消息ID [英] Single function to write for all message id

问题描述

我是Excel VBA的新手，我开始编写代码，该代码执行得很好，但是我需要一个建议，如何在不需要为所有"ID"编写代码的情况下编写函数.

Iam new to Excel VBA , I am started writing a code , which was executed fine, but I need a suggestion how to write a function where i dont need to write code for all "ID".

例如: 我有ID(1000x，10000，2000X，20000)的主要工作表. 我只想搜索编号不带字母的ID，然后将其与另一个具有相同ID的工作表进行比较，如果可以的话，请获取对应的ID第三列数据并将其汇总到主工作表中.

For example : I have main works sheet having ID(1000x, 10000, 2000X,20000). I want to search only ID with number not with alphabet, and compare it with another worksheet , having the same ID , if then get the corrosponding ID 3rd column data and conacdenate all them into main worksheet .

我有主要工作表("Tabelle1")在Coloumn A中具有所有ID(10000,20000)，我想要ID 10000的B列中的ID 10000信息.有时我有10000次，四次.想要将信息粘贴到另一个工作表("Test_2")，我想收集所有10000和对应的数据.

I have main worksheet ("Tabelle1")having all the ID(10000,20000) in Coloumn A ,I want the infomration of ID 10000 in column B of ID 10000. some times i have 10000 for four times . Want to paste infomration to another worksheet ("Test_2"), I want to collect all the 10000 and corrosponding data .

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

In BSM:STM:IO

A B
ID
1000X
10000
10001
...

A B
ID
1000X
10000
10001
...

在Tabelle1中
B C
ID
1000 abc
1000 xyz
10001 lmn
2000 def
" 我只想将"BSM:STM:Io"中的数字与"tabelle1"进行比较.例如，取"BSM_STM_io"中的第一个值10000与tabele进行比较，取"tablle1"中对应的Coloumn"C"的值，然后将其放入BSM_STM:Io 1000中的单个单元格中

in Tabelle1
B C
ID
1000 abc
1000 xyz
10001 lmn
2000 def
" I want to compare only digit from"the "BSM:STM:Io" with "tabelle1". Example take the the first value 10000 from "BSM_STM_io" compare with tabele take the the value of corrosponding Coloumn "C" in "tablle1" and put it into single cell in 1000 of BSM_STM:Io

在工作表中
• A，B，C列

在此处输入图片描述

推荐答案

让我们假设工作表"BSM_STF_iO"包含以A2开头的A列中的ID信息，而工作表Tabelle1包含的B列中从B2开头的所需遮盖信息(例如: B列:ID，C列:要保留的信息).下面的代码将隐藏内容，并写在BSM_STF_iO工作表中.

Lets assume worksheet "BSM_STF_iO" contains the ID information in A column beginning with A2 and worksheet Tabelle1 contains the required concaetenation information in B Column beginning from B2 (ex: Column B: IDs, Column C: information to concaetenate). Below code will concaetenate the contents and write in BSM_STF_iO sheet.

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

及以下功能取自如何从字符串中查找数字?

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

这篇关于单一功能可写入所有消息ID的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！