查找方法唯一值不会自动显示在列

时间:2017-10-12 02:36:33

标签: excel excel-vba vba

我使用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

1 个答案:

答案 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