Tabelle durch Daten einer 2ten aktualisieren

Forumthread: Tabelle durch Daten einer 2ten aktualisieren

18.01.2009 10:26:00

Reini

Hallo liebe Forumsgemeinde,
ich habe ein kleines Problem.
Ich habe 2 Tabellen die gleich aufgebaut sind.
Tabelle 1 :
2 Spalten. In Spalte A eine Zahl, in Spalte B irgendein text.
Tabelle 2:
gleicher Aufbau.
Nun sollte ein Makro überprüfen welche Zahlen aus Tabelle 1 noch nicht in Tabelle 2 vorhanden sind und diese dann in Tabelle 2 samt dem Text aus Spalte B einfügen. Das heisst die Tabelle 2 sollte immer durch neue einträge aus Tabelle 1 erweitert werden.
Wäre super wenn mir dabei jemand helfen könnte.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabelle durch Daten einer 2ten aktualisieren

18.01.2009 10:55:00

Tino

Hallo,
ist die letzte Spalte bei Dir noch frei, kannst Du es mal mit diesem Makro versuchen.

Sub Makro1()
Dim Bereich As Range

With Application
 .ScreenUpdating = False
 .EnableEvents = False
    
    With Sheets("Tabelle1")
        Set Bereich = .Range("A2", .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
        Set Bereich = Bereich.Offset(0, .Columns.Count - 1)
        
        Bereich.FormulaR1C1 = "=IF(COUNTIF(Tabelle2!C1,RC1)=0,0,"""")"
        
        On Error GoTo KeineZelle:
        Set Bereich = .Columns(.Columns.Count).SpecialCells(xlCellTypeFormulas, 1)
        Set Bereich = Range(Bereich.Offset(0, -(Columns.Count - 1)), Bereich.Offset(0, -(Columns.Count - 2)))
        
        With Sheets("Tabelle2")
         Bereich.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With 'Sheets("Tabelle2") 
        
KeineZelle:
        .Columns(.Columns.Count).Delete
    End With 'Sheets("Tabelle1") 
 
 .ScreenUpdating = True
 .EnableEvents = True
End With 'Application 


End Sub

Gruß Tino

Korrektur, Excel macht da nicht mit...

18.01.2009 13:42:00

Tino

Hallo,
leider verbindet Excel die Zellen beim Offset gehen, nimm besser diese Version.

Sub Makro1()
Dim Bereich As Range
Dim Zellen As Range
Dim myTab1 As Worksheet, myTab2 As Worksheet
With Application
 .ScreenUpdating = False
 .EnableEvents = False
 

Set myTab1 = Sheets("Tabelle1") 'Deine Tabelle1 
Set myTab2 = Sheets("Tabelle2") 'Deine Tabelle2 
    
    With myTab1
        Set Bereich = .Range("A2", .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
        Set Bereich = Bereich.Offset(0, .Columns.Count - 1)
        
        Bereich.FormulaR1C1 = "=IF(COUNTIF(Tabelle2!C1,RC1)=0,0,"""")"
        
        On Error GoTo KeineZelle:
        Set Bereich = .Columns(.Columns.Count).SpecialCells(xlCellTypeFormulas, 1)
        
        With myTab2
        For Each Zellen In Bereich
              
         myTab1.Range(myTab1.Cells(Zellen.Row, 1), myTab1.Cells(Zellen.Row, 2)).Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        
        Next Zellen
        End With 'myTab2 
  
        
KeineZelle:
        .Columns(.Columns.Count).Delete
    End With 'myTab1 
 
 .ScreenUpdating = True
 .EnableEvents = True
End With 'Application 


End Sub

Gruß Tino

AW: Korrektur, Excel macht da nicht mit...

22.01.2009 13:58:47

reini

hallo, danke für die Hilfe, funktioniert perfekt. Nur noch eine kleine Frage, was müsste ich denn verändern wenn das Suchkriterium nicht in der ersten sondern zb in der 3ten Spalte wäre?

AW: Korrektur, Excel macht da nicht mit...

22.01.2009 14:24:00

Tino

Hallo,
ändere wie in der Grafik gezeigt in der Formelzeile die Werte entsprechend.
Userbild

Gruß Tino

AW: Korrektur, Excel macht da nicht mit...

23.01.2009 08:04:59

reini

danke für die schnelle antwort.
leider funktioniert es noch nicht richtig.
um es nochmals zu beschreiben, ich müsste also nicht die Spalte A von Tabelle 1 mit Spalte A von Tabelle 2 vergleichen, sondern die Spalte M von Tabelle 1 mit der Spalte M von Tabelle 2 und dann die einträge aus Tabelle 1 die noch nicht in Tabelle 2 sind in diese übernehmen.

AW: Korrektur, Excel macht da nicht mit...

23.01.2009 08:22:00

Tino

Hallo,
versuche es mal hiermit,
es wird die Spalte M von Tabelle1 mit der Spalte M der Tabelle2 verglichen und
die die nicht vorhanden sind nach Tabelle2 kopiert.

Sub Makro1()
Dim Bereich As Range
Dim LCol As Long, LColFomel As Long
With Application
 .ScreenUpdating = False
 .EnableEvents = False
    
    With Sheets("Tabelle1")
        
        Set Bereich = .Range("M2", .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, 13))
        LColFomel = Bereich.Column
        LCol = .Columns.Count - Bereich.Column
        Set Bereich = Bereich.Offset(0, LCol)
        
        Bereich.FormulaR1C1 = "=IF(COUNTIF(Tabelle2!C" & LColFomel & ",RC" & LColFomel & ")=0,0,"""")"
        
        On Error GoTo KeineZelle:
        Set Bereich = .Columns(.Columns.Count).SpecialCells(xlCellTypeFormulas, 1)
        Set Bereich = Range(Bereich.Offset(0, -(LCol)), Bereich.Offset(0, -(LCol - 1)))
        
        With Sheets("Tabelle2")
         Bereich.Copy .Cells(.Rows.Count, LColFomel).End(xlUp).Offset(1, 0)
        End With 'Sheets("Tabelle2") 
        
KeineZelle:
        .Columns(.Columns.Count).Delete
    End With 'Sheets("Tabelle1") 
 
 .ScreenUpdating = True
 .EnableEvents = True
End With 'Application 


End Sub

Gruß Tino

AW: Korrektur

23.01.2009 08:52:00

Tino

Hallo,
habe ausversehen den ersten Code genommen, ich gehe nochmal ins Bett. ;-)

Sub Makro1()
Dim Bereich As Range, myZ As Range
Dim LCol As Long, LColFomel As Long
Dim myTab1 As Worksheet, myTab2 As Worksheet

With Application
 .ScreenUpdating = False
 .EnableEvents = False

Set myTab1 = Sheets("Tabelle1") 'Deine Tabelle1 
Set myTab2 = Sheets("Tabelle2") 'Deine Tabelle2 
    
    With myTab1
        
        Set Bereich = .Range("M2", .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, 13))
        LColFomel = Bereich.Column
        LCol = .Columns.Count - Bereich.Column
        Set Bereich = Bereich.Offset(0, LCol)
        
        Bereich.FormulaR1C1 = "=IF(COUNTIF(" & myTab2.Name & "!C" & LColFomel & ",RC" & LColFomel & ")=0,0,"""")"
        
        On Error GoTo KeineZelle:
        Set Bereich = .Columns(.Columns.Count).SpecialCells(xlCellTypeFormulas, 1)
      
        With myTab2
         For Each myZ In Bereich
            myTab1.Range(myTab1.Cells(myZ.Row, LColFomel), myTab1.Cells(myZ.Row, LColFomel + 1)).Copy .Cells(.Rows.Count, LColFomel).End(xlUp).Offset(1, 0)
         Next myZ
        End With 'Sheets("Tabelle2") 
        
KeineZelle:
        .Columns(.Columns.Count).Delete
    End With 'Sheets("Tabelle1") 
 
 .ScreenUpdating = True
 .EnableEvents = True
End With 'Application 


End Sub

Gruß Tino

AW: Korrektur

26.01.2009 08:32:00

reini

Danke, hab aber leider noch ein problem. Er vergleicht jetzt zwar die richtigen Spalten. leider kopiert er aber nur die einträge der Spalte M und N in die 2te Tabelle. Er müsste allerdings die ganze zeile einfügen, von Spalte A bis S. Bekomm den Code leider nicht so hin dass es passt.
Reini

Beliebteste Forumthreads (12 Monate)

Tabelle durch Daten einer 2ten aktualisieren

Forumthread: Tabelle durch Daten einer 2ten aktualisieren

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Tabelle durch Daten einer 2ten aktualisieren

Forumthread: Tabelle durch Daten einer 2ten aktualisieren

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread