根據列中的文本將單元格值復制並粘貼到特定的單元格

Question

我有一個Excel文件，看起來像...

在宏之后，將是最終結果：

[

我想要讀取列“ B”的宏，並將列“ C”中的第一個國家粘貼到列“ A”的相同單元格中，在他找到“ B”中的重復單元格后，他從列“ C”中復制下一個國家與我在第一國家等撰寫的內容相同

我從類似的問題中找到了代碼，並嘗試使其適應我的任務：

Sub GetText2()
Dim CellValue As String
Dim RowCrnt As Integer
Dim RowMax As Integer

With Sheets("Sheet1")   
  RowMax = .Cells(Rows.Count, "B").End(xlUp).Row
  For RowCrnt = 2 To RowMax
    CellValue = .Cells(RowCrnt, 2).Value
    If CellValue <> "" Then
      .Cells(RowCrnt, 1).Value = Cells(RowCrnt, 5)
    Else
      .Cells(RowCrnt, 1).Value = .Cells(RowCrnt - 1, 5).Value
    End If
  Next
End With
End Sub

但是，它並不能正常工作。

有人可以幫我這些嗎？ 謝謝。

Answer 1

我認為這可以滿足您的需求。 您的代碼似乎不檢查B列值是否已存在。

Sub x()

Dim r1 As Long, r2 As Long

r1 = 2: r2 = 2

Do While Cells(r1, 2) <> vbNullString
    If IsNumeric(Application.Match(Cells(r1, 2), Range(Cells(1, 2), Cells(r1 - 1, 2)), 0)) Then
        r2 = r2 + 1
    End If
    Cells(r1, 1).Value = Cells(r2, 3).Value
    r1 = r1 + 1
Loop

End Sub

Answer 2

我認為它將解決您的問題。

Private Sub GetText2()
Dim CellValue As String
Dim RowCrnt As Integer
Dim RowMaxB As Integer
Dim RowMaxC As Integer
Dim RowMaxA As Integer
Dim wsh As Worksheet
Dim i As Integer
Dim checkDup As Integer


Set wsh = ThisWorkbook.Sheets("Sheet1")
'get max row of each Row
RowMaxB = wsh.Cells(Rows.Count, "B").End(xlUp).Row
RowMaxC = wsh.Cells(Rows.Count, "C").End(xlUp).Row
RowMaxA = wsh.Cells(Rows.Count, "A").End(xlUp).Row

If RowMaxA > 2 Then
'Clear contents of column A before write value. if > 2 to case Column A is blank
wsh.Range("A2:A" & RowMaxA).ClearContents
End If

'Run each row of column B
  For RowCrnt = 2 To RowMaxB
  checkDup = 0
    CellValue = wsh.Cells(RowCrnt, 2).Value
    If CellValue <> "" Then
         If RowCrnt = 2 Then
         'if check row is first row so set first value of column C to it
         checkDup = 0
         Else

             For i = RowCrnt - 1 To 2 Step -1
             ' loop backwards to find duplicate value in column B
                If wsh.Cells(i, 2).Value = CellValue And wsh.Cells(i, 1).Value <> "" Then
                ' if exist duplicate value so run function to find next value of column C
                wsh.Cells(RowCrnt, 1).Value = findInColC(wsh, wsh.Cells(i, 1).Value, RowMaxC, "C")
                checkDup = 1
                Exit For
                Else

                End If

            Next
         End If

        If checkDup = 0 Then
            wsh.Cells(RowCrnt, 1).Value = wsh.Cells(2, 3).Value
        Else
        End If

    Else
    End If
  Next

'release variables
 CellValue = ""
 RowCrnt = 0
 RowMaxB = 0
 RowMaxC = 0
 RowMaxA = 0
 Set wsh = Nothing
 i = 0
 checkDup = 0

End Sub
Function findInColC(wshSheet As Worksheet, stringFind As String, lastRow As Integer, FindColumn As String) As String
Dim i As Integer
For i = 2 To lastRow
If stringFind = wshSheet.Cells(i, FindColumn).Value Then
    If i = lastRow Then
    'if value find in A is last value in column C so set first value of Column C for it.
    findInColC = wshSheet.Cells(2, FindColumn).Value
    Else
    findInColC = wshSheet.Cells(i + 1, FindColumn).Value
    End If

Else
End If
Next

End Function