Kopieren Sie einen Variablenwert und fügen Sie ihn in ein anderes Spread Sheet ein

Question

was ich gerade tun möchte, ist ein Bereich (sagen wir C: C), gehen Sie durch alle Zellen mit Wert und fügen Sie sie in eine andere Tabelle ein.

Mein Ziel ist es, einen Variablenwert zu kopieren (weil ich nicht weiß, wieviele Werte ich in C: C haben würde) und auf ein anderes Blatt einzufügen, damit ich einen neuen Bereich mit allen Werten haben kann (gab es keine wiederholten Werte).

Wie wird die If-Anweisung (für Variablenwerte) codiert?

Wenn mir jemand helfen kann, werde ich dankbar sein. Dies ist, was ich zu diesem Punkt haben:

Sub Test_1() 
    ' Go through each cells in the range 
    Dim rg As Range 
    Dim copySheet As Worksheet 
    Dim pasteSheet As Worksheet 

    Set copySheet = Worksheets("Data") 
    Set pasteSheet = Worksheets("Data_storage") 

    For Each rg In Worksheets("Data").Range("C:C") 

     If rg.Value = "Client 1" Then 'Instead of "Client 1" should be a variable value because "Client 1" will be a repetead value in C:C 
      copySheet.Range("C2").Copy 'Starting the counter in C2 
      pasteSheet.cells(Row.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValue 

     End If 

    Next 

End Sub 

Answer 1

Ihre Werte in "Data" Arbeitsblatt unter der Annahme:

• sind in der Spalte "C"

• Start aus Reihe 1, mit einem "header"

dann können Sie diesen Code versuchen:

Option Explicit 

Sub Test_1() 
    Dim sourceRng As Range, pasteRng As Range, cell As Range 

    Set pasteRng = Worksheets("Data_storage").Range("A1") '<--| set the upper-left cell in "paste" sheet 

    With Worksheets("Data") '<--| reference "source" sheet 
     Set sourceRng = .Range("D1", .Cells(.Rows.Count, "C").End(xlUp)) '<--| set the "source" range to columns "C:D" from row 1 down to last non empty cell in column "C" 
    End With 

    With sourceRng '<--| reference "source" range 
     .Sort key1:=.Range("a1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, header:=xlYes '<--| sort it by its column 1 and then by its column 2 
     pasteRng.Resize(.Rows.Count).value = .Resize(, 1).value '<--| paste its column 1 values to "Paste" sheet column 1 
     pasteRng.CurrentRegion.RemoveDuplicates Columns:=Array(1) '<--| leave only unique values in "paste" range 
     Set pasteRng = pasteRng.Range(pasteRng.Offset(1), pasteRng.End(xlDown)) '<--| skip "paste" range header 
     For Each cell In pasteRng '<--| loop through unique values in "paste" range column 1 
      .AutoFilter field:=1, Criteria1:=cell.value '<--| filter "source" range column 1 with current unique value 
      .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Copy '<--| copy "source" range" column 2 filtered cells 
      cell.Offset(, 1).PasteSpecial Transpose:=True '<--| ... and paste/transpose them aside current unique value in "paste" range 
     Next cell 
     .Parent.AutoFilterMode = False '<--| .. show all rows back... 
    End With 
End Sub 

Answer 2

Wenn Sie nicht sortieren möchten, können Sie einen Makro so etwas wie dies aufzeichnen kann:

• Wählen Sie Spalte C

• Start ➤ Finden & Wählen ➤ Konstanten
  http://www.contextures.com/images/formatformulas04.png

• Kopieren Sie die Auswahl und fügen Sie sie in das andere Blatt

ein

• Daten ➤ Duplikate entfernen
  http://blog.contextures.com/wp-content/uploads/2009/12/removedups02.jpg

P. S. Früher habe ich # 3 von here:]

Answer 3

Ein Wörterbuch kann auch nützlich sein, besonders wenn Sie kompliziertere Filterung oder Berechnung planen:

Public Sub CopyUnique(rngSource As Range, rngDestinationFirst As Range) 
    If rngSource Is Nothing Or rngSource.Worksheet.UsedRange Is Nothing Then 
     Exit Sub 
    End If 
    Dim dctValues As Scripting.Dictionary: Set dctValues = New Scripting.Dictionary ' Requires Tools > References > Microsoft Scripting Runtime 
    Dim rngSourceUsed As Range: Set rngSourceUsed = Application.Intersect(rngSource, rngSource.Worksheet.UsedRange) 
    Dim varCell As Variant: For Each varCell In rngSourceUsed.Cells: Dim rngCell As Range: Set rngCell = varCell 
     If dctValues.Exists(rngCell.Value) = False Then 
      dctValues.Add varCell.Value, varCell.Value ' varCell.Formula may be also interesting depending on the business logic 
     End If 
    Next varCell 
    Dim varValues() As Variant: ReDim varValues(0 To dctValues.Count - 1, 0 To 0) 
    Dim i As Long: i = LBound(varValues, 1) 
    Dim varValue As Variant: For Each varValue In dctValues.Keys 
     varValues(i, 0) = varValue 
     i = i + 1 
    Next varValue 
    rngDestinationFirst.Resize(dctValues.Count, 1).Value = varValues 
End Sub 

Public Sub TestCopyUnique() 
    CopyUnique ActiveSheet.Range("C:C"), Workbooks.Add(xlWBATWorksheet).Worksheets(1).Range("A1") 
End Sub