Question

在Excel中，

我在Sheet1 / A列上有大量信息，想要搜索特定文本（从单词N1 * PE *开始到＃34之前的9个数字; ~N＆＃34;），

然后从正确列表（Sheet2 / A列）＆amp;中比较（Sheet1 / A列）然后将其粘贴到单独的工作表（Sheet3 / A列）上。

以下是一个例子：

在表1 A栏中:(我的错误信息如下）

EDI DEPARTMENT * TE * 2658018518~N1 * PE * ELMHUR

ST CENTER * XX * 564824568~N4 * GREAT NECK * NY * 11023

N1 * PE COOPER XX * 333333333~N4 *纽约* NY * 10077-5281~REF * TJ * 133988001~LX * 7111~

正如您所注意到的那样，ELMHURST这个词已被破坏。

我想要完成的是根据样本列表（在Sheet2 / A列上）替换错误的文本（在Sheet1 / A列上）并将其粘贴在Sheet3 / A列上 - ＆gt; 使用相同的格式。

这里是（正确）样本信息列表（Sheet2 / A列）：

N1 * PE ELMHURST CENTER XX * 454545457

N1 * PE COOPER XX * 123457777

所以，结果应该是：

在Sheet3 / A列中......

EDI部门* TE * 2658018518~N1 * PE * ELMHUR

ST CENTER * XX * 454545457~N4 * GREAT NECK * NY * 11023

N1 * PE COOPER XX * 123457777~N4 *纽约* NY * 10077-5281~REF * TJ * 133988001~LX * 7111~

以下代码不完整。因为它只能复制和粘贴Sheet2 A列。

Option Explicit


Public Sub Transfer()

Dim lngRow As Long, lngWriteRow As Long, strTemp As String

Dim shtRaw As Worksheet, shtNew As Worksheet

'   Initialize

lngWriteRow = 1                     'The row we're writing to

Set shtRaw = Sheets("Sheet1")       'The raw data worksheet

Set shtNew = Sheets("Sheet2")       'The sheet with the concatenated text

For lngRow = 1 To shtRaw.UsedRange.Rows.Count

    If InStr(1, shtRaw.Cells(lngRow, 1), "N1*PE*", vbTextCompare) > 0 Then

'           Grab the end of this cell's text starting at N1*PE*

        strTemp = Mid(shtRaw.Cells(lngRow, 1), InStr(1, shtRaw.Cells
 (lngRow, 1), "N1*PE*", vbTextCompare))

'           Add the start of the next cell's text, up to the ~N


    strTemp = strTemp & Left(shtRaw.Cells(lngRow + 1, 1), InStr(1, shtRaw.Cells(lngRow + 1, 1), "~N", vbTextCompare))


'           Write the concatenated string to the other worksheet
            shtNew.Cells(lngWriteRow, 1) = strTemp

'           NEED TO DO SOMETHING HERE... COMPARE THE TEXT FROM THE LIST AND PASTE IT ON SHEET 3 COLUMN A            

'           Move down one row for the next time we write to the other sheet
        lngWriteRow = lngWriteRow + 1

    End If

Next lngRow

'Sort the NPIs

Sheets("Sheet2").Select

Range("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes


'   Clean up memory

Set shtRaw = Nothing

Set shtNew = Nothing


End Sub

非常感谢提前......

Answer 1

以下可能有用。您的替换值似乎与原始文件相比具有任意缺失*和空格字符（即PE * ELM ..与PEELM ..）。这使得很难确定每个修复的行应该在Sheet3上有多长。我做出了一个任意的决定，它应该与我为此演示目的连接的两个单元格中的第一个相同的长度，但是在处理了许多行之后，该方法可能需要进行一些改进。如果您需要匹配现有的起始字符，您需要执行类似于我在此处所做的操作，并找到以下行开始字符的位置并相应地划分NewCombinedString。

Sub FixSheet1ColumnA()
    Dim i As Integer
    i = 1
    Do While Sheet1.Range("A" & i) <> ""
        'Combined adjoining rows to account for values which overlap between rows
        Dim Cell1Value As String
        Dim Cell2Value As String
        Dim CombinedString As String
        'The upper of the rows should come from whatever has been processed onto
        'Sheet3 except for the very first row which has to come from Sheet1
        If i = 1 Then Cell1Value = Sheet1.Range("A" & i) Else Cell1Value = Sheet3.Range("A" & i)
        Cell2Value = Sheet1.Range("A" & i + 1)
        CombinedString = Cell1Value & Cell2Value
        Dim SearchString As String
        'Strip the * and space characters out of the string to search it as there
        'seem to be random extras of these in Sheet1 column A
        SearchString = Replace(Replace(CombinedString, " ", ""), "*", "")
        'Cycle through Sheet2 column A to see if there are any matches for the
        'first n-9 digits of each value there, also removing * and space characters
        'for consistency
        Dim j As Integer
        j = 1
        Do While Sheet2.Range("A" & j) <> ""
            Dim ReplacementString As String
            ReplacementString = Sheet2.Range("A" & j)
            Dim FindString As String
            FindString = Replace(Replace(ReplacementString, " ", ""), "*", "")
            'determine if the first n-9 characters of the given Sheet2 value are found
            Dim SubStringPosition As Integer
            SubStringPosition = InStr(1, SearchString, Left(FindString, Len(FindString) - 9))
            If SubStringPosition <> 0 Then
                'Find the tilde that immediately precedes the string to be replaced
                Dim FirstTildePosition As Integer
                FirstTildePosition = InStr(SubStringPosition, CombinedString, "~")
                'Find the tilde that follows it
                Dim SecondTildePosition As Integer
                SecondTildePosition = InStr(FirstTildePosition + 1, CombinedString, "~")
                Dim NewCombinedString As String
                NewCombinedString = Left(CombinedString, FirstTildePosition) _
                    + ReplacementString _
                    + Right(CombinedString, Len(CombinedString) - SecondTildePosition + 1)
                Exit Do
            End If
            j = j + 1
        Loop
        'Populate the first part of potentially fixed CombinedString into Sheet3
        If i = 1 Then Sheet3.Range("A" & i) = Left(NewCombinedString, Len(Cell1Value))
        Sheet3.Range("A" & i + 1) = Right(NewCombinedString, Len(NewCombinedString) - Len(Cell1Value))
        i = i + 1
    Loop
End Sub

搜索特定文本，比较，然后复制＆amp;粘贴在VBA中

1 个答案: