[英]Excel VBA Macros to copy and paste cell value to certain cells based on text in column
[英]Copy and paste cell value to specific cells based on text in column
我有一个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
但是,它并不能正常工作。
有人可以帮我这些吗? 谢谢。
我认为这可以满足您的需求。 您的代码似乎不检查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
我认为它将解决您的问题。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.