перебирать столбец и брать элемент только один раз

Question

изображение листа, откуда я хочу взять значения.

У меня есть лист, где я хочу перебрать один столбец. Колонка "Е" в листе 3. В этом столбце много дубликатов. Он должен принять значение и вставить его в столбец листа «C». Важно, чтобы у меня не было дубликатов на листе1. Я попытался решить эту проблему с помощью словарей. Но я не могу заставить его работать. Кто-нибудь может мне помочь?

Это код, который я получил на данный момент. Я застрял и не могу получить дальше.

Sub test()
    Const START_ROW = 11
    Const MAX_ROW = 40
    Const CODE_SHT1 = "C"
    Const CODE_SHT4 = "E"
    Const CVR_SHT4 = "C"
    Const CVR_SHT3 = "C"
    Const BROKER_SHT4 = "E"



    ' sheet 4  columns
    'C - Employer CVR MD
    'D - Employer name
    'E - broker code
    'F - Broker name
    '? Employer CVR CER

    Dim wb As Workbook, wbNew As Workbook
    Dim ws1 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, wsNew As Worksheet
    Dim iRow As Long, iLastRow, iTargetRow As Long, iCopyRow As Long
    Dim msg As String, i As Integer, j As Integer
    Dim count As Long, countWB As Integer
    Dim WkSht_Src   As Worksheet
    Dim WkBk_Dest   As Workbook
    Dim WkSht_Dest  As Worksheet
    Dim Rng As Range

    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("BrokerSelect")
    Set ws3 = wb.Sheets("ContributionExceptionReport")
    Set ws4 = wb.Sheets("MasterData")



    Dim dict As Object, dictCVR As Object, dictBROKER As Object, sKey As String, ar As Variant
    Dim sCVR As String, arCVR As Variant
    Dim sBROKER As String, arBROKER As Variant

    Set dict = CreateObject("Scripting.Dictionary")
    Set dictCVR = CreateObject("Scripting.Dictionary")
    Set dictBROKER = CreateObject("Scripting.Dictionary")

    ' Get broker code + broker name from sheet 3 and insert into sheet one
    iLastRow = ws4.Cells(Rows.count, BROKER_SHT4).End(xlUp).Row
    For iRow = 18 To iLastRow
    sKey = ws4.Cells(iRow, BROKER_SHT4)
    If dictBROKER.exist(sKey) Then
        dictBROKER(sKey) = dictBROKER(sKey) & ";" & iRow ' matched row on sheet 1
    Else
            dictBROKER(sKey) = iRow
        End If
        MsgBox (dict(sKey))

    Next
End Sub

Answer 1

Sub exportSheet2 ()

Const START_ROW = 11
Const MAX_ROW = 40
Const BROKER_SHT4 = "E"

Dim wb As Workbook, wbNew As Workbook
Dim ws1 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, wsNew As Worksheet
Dim iRow As Long, iLastRow, iTargetRow As Long, iCopyRow As Long
Dim msg As String, i As Integer, j As Integer
Dim count As Long, countWB As Integer
Dim WkSht_Src   As Worksheet
Dim WkBk_Dest   As Workbook
Dim WkSht_Dest  As Worksheet
Dim Rng As Range
Dim r As Long

Set wb = ThisWorkbook
Set ws1 = wb.Sheets("sheet1")
Set ws3 = wb.Sheets("sheet3")
Set ws4 = wb.Sheets("sheet4")



Dim dict As Object, dictCVR As Object, sKey As String, ar As Variant
Dim sCVR As String, arCVR As Variant
Dim sBROKER As String, arBROKER As Variant

Set dict = CreateObject("Scripting.Dictionary")
Set dictCVR = CreateObject("Scripting.Dictionary")
Set dictBROKER = CreateObject("Scripting.Dictionary")

' Get broker code + broker name from sheet 3 and insert into sheet one
iLastRow = ws4.Cells(Rows.count, BROKER_SHT4).End(xlUp).Row
r = 11
For iRow = 13 To iLastRow
    sKey = ws4.Cells(iRow, BROKER_SHT4)
    If dictBROKER.exists(sKey) Then
        dictBROKER(sKey) = dictBROKER(sKey) & ";" & iRow ' matched row on sheet 1
    Else
        dictBROKER(sKey) = iRow

    ws1.Range("E" & r) = sKey
    ws1.Range("F" & r) = ws4.Cells(iRow, "F")
    r = r + 1
    End If

Next

Answer 2

ваш код должен быть изменен (как минимум):

• a Next подтверждение больше (что в конце)

• использование dict вместо dictBROKER

• неправильный отступ (чтобы иметь больше шансов понять и контролировать его)

так что здесь именно после этих изменений

Sub Test()

    Const START_ROW = 11
    Const MAX_ROW = 40
    Const BROKER_SHT4 = "E"


    Dim wb As Workbook, wbNew As Workbook
    Dim ws1 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, wsNew As Worksheet
    Dim iRow As Long, iLastRow, iTargetRow As Long, iCopyRow As Long
    Dim msg As String, i As Integer, j As Integer
    Dim count As Long, countWB As Integer
    Dim WkSht_Src   As Worksheet
    Dim WkBk_Dest   As Workbook
    Dim WkSht_Dest  As Worksheet
    Dim Rng As Range

    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("BrokerSelect")
    Set ws3 = wb.Sheets("ContributionExceptionReport")
    Set ws4 = wb.Sheets("MasterData")




    Dim dictBROKER As Object, dictCVR As Object, sKey As String, ar As Variant
    Dim sCVR As String, arCVR As Variant
    Dim sBROKER As String, arBROKER As Variant

    Set dictBROKER = CreateObject("Scripting.Dictionary")

    ' Get broker code + broker name from sheet 3 and insert into sheet one
    iLastRow = ws4.Cells(Rows.count, BROKER_SHT4).End(xlUp).Row
    For iRow = 13 To iLastRow
        sKey = ws4.Cells(iRow, BROKER_SHT4)
        If dictBROKER.exists(sKey) Then
            dictBROKER(sKey) = dictBROKER(sKey) & ";" & iRow ' matched row on sheet 1
        Else
            dictBROKER(sKey) = iRow
        End If
        MsgBox (dictBROKER(sKey))
    Next

    ' add cvr records from sheet3 if any
    sBROKER = ws4.Cells(iCopyRow, BROKER_SHT4)
    If dictBROKER.exists(sBROKER) Then
         arBROKER = Split(dictBROKER(sBROKER), ";")
         For j = LBound(arBROKER) To UBound(arBROKER)
             If j > 0 Then iTargetRow = iTargetRow + 1

             ' copy col C to D
             iCopyRow = arBROKER(j)
             Debug.Print sBROKER, j, iCopyRow

         Next
    Else
        count = count + 1
    End If
End Sub