我使用find方法比较不同表格中的两列(A和B)。列A是更新列,而列B是复制列。代码将循环遍历列并查找匹配情况。如果A列中有唯一值,它会将其复制到B列。我已设法对其进行编码,但唯一值不会自动出现在B列中。只有当我单击A列的唯一值单元格时才会然后被复制到B列。
有谁知道为什么它无法自动更新?
A栏中的代码:
Private Sub Worksheet_SelectionChange(ByVal target As Range)
If target.Column = 9 Then
fabric = ActiveCell.Value
Module4.ChkFabric (fabric)
End If
End Sub
我已经使用模块复制到B列:
Sub ChkFabric(ByRef fabric As String)
Dim Rng, TgtC, ResC As Range
Dim PrePlan As Worksheet
Set PrePlan = Worksheets("Pre Master Plan")
With PrePlan
Set ResC = .Range("A:A")
endrow = .Cells(PrePlan.Rows.Count, "A").End(xlUp).Row
End With
With ResC
Set Rng = .Find(what:=Trim(fabric), LookIn:=xlValues, lookat:=xlWhole,
searchorder:=xlByRows, searchdirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Else
PrePlan.Cells(endrow + 1, 1) = fabric
End If
End With
End Sub
答案 0 :(得分:0)
我写了一段代码来从一列中获取唯一值(如果它有重复项,则不包括项目)并写入另一列
Sub uniq()
Dim cntOccur As Integer
Dim rowCount As Integer
Dim Checkcol As Integer, Targetcol As Integer
Dim currentRowValue As String
Dim currentRow As Integer, brow As Integer
Checkcol = 1 'Denotes A column
Targetcol = 2 'Denotes B column
rowCount = Cells(Rows.Count, Checkcol).End(xlUp).Row
brow = 0
For currentRow = 1 To rowCount
currentRowValue = Cells(currentRow, Checkcol).Value
' Check the number of occurrence of each and every cell in column A
cntOccur = Application.WorksheetFunction.CountIf(Range("A1:A" & rowCount), currentRowValue)
If cntOccur = 1 Then
brow = brow + 1
' If it is unique and has no duplicates then write in to B
Cells(brow, Targetcol).Value = currentRowValue
End If
Next
End Sub