Visual Basic Excel doofes Problem

InExplicit

Grünschnabel
hi,
folgendes Problem!

Wenn tabelle1.Spalte("J:J") = Tabelle3.Spalte("A:A") ist dann
Tabelle10.Spalte("G:G")=Tabelle3.Spalte("B:B")


soweit sieht es ja leicht und einfach aus, aber ich bekomme egal was ich machen und wo ich mir denke das könnte richtig sein die Fehlermeldung 91 (Object variable oder with block not set) hmmm damit kann ich leider nicht wirklich was anfangen!

Mein letzter Code sieht so aus:

If Tabelle1.Range("J:J") = Tabell3.Range("A:A") Then
Tabelle10.Range("G:G") = Tabelle3.Range("B:B")
Else
Tabelle10.Range("G:G") = ""
End If


oder im neuesten Code (oben gepostet) bekomme ich die Fehlermeldung"Object Required"

Bitte helft mir rasch, ich probier schon 2 tage daran herum und dreh bald durch


Danke!

Lg InEx
 
'test
Dim Tab1_r As Range
Dim She3_r As Range
Dim Tab10_r As Range

Set Tab1_r = Tabelle1.Range("J:J").Comment
Set She3_r = Sheet3.Range("A:A").Comment
Set Tab10_r = Tabelle10.Range("J:J").Comment

If Tab1_r = She3_r Then
Tab10_r = She3_r
Else
Tab10_r = ""
End If

'test ende

das ist möglichkeit 2 die meines erachtens nach gehen sollte, müsste. Aber das tut sie nicht!

Bitte Helft mir!

Danke
 
Hallo,

soweit ich weiss kannst du auf diesen Weg keine kompletten Zellen Reichen vergleichen.

Aber über einen Umweg kannst du dein Ziel vielleicht doch erreichen:

füge in eine Tabelle eine weitere Spalte ein und schreibe dort in jede Zelle eine Formel rein die deine Werte vergleicht, also zB
=wenn(Tabelle1!J1=Tabelle3!A1;0;1)

Im Spaltenkopf lässt du Excel jetzt noch davon die Gesamtsumme ziehen (=Summe(bereich))

Und jetzt kannst du mit dem Makro arbeiten.
Nimm einfach die Summe der neu eingefügten Spalte, bei Ergebnis "0" ist keine Veränderung also kopiere zelle für Zelle von A nach C. Wenn größer "0", dann kopiere von B nach C.

also in etwa so:
Code:
  If Tabelle1.Cells(1, 7) = 0 Then    '1 steht für erste Zeile und 7 für Spalte (=G)
  'kopieren
    Tabelle3.Activate
    Tabelle3.Columns("B:B").Select
    Selection.Copy
    Tabelle10.Activate
    Tabelle10.Columns("G:G").Select
    ActiveSheet.Paste
  Else
  'bzw. löschen
   Tabelle10.Activate
    Tabelle10.Columns("G:G").Select
    Selection.Cut
  End If


Gruß DuckDonald
 
Hallo lnExplicit,
es bietet sich auch ein Vergleich der einzelnen Zellen an. Das könnte zum Beispiel so aussehen:

Code:
Sub Test()
  Dim iZ As Integer
  Dim c2 As Range
  Dim r1 As Range
  Dim r2 As Range
  Dim r3 As Range
  Dim r4 As Range
  ' CurrentRegion geht nur wenn keine leeren Zellen in den Spalten
  Set r1 = Tabelle1.Range("J:J").CurrentRegion
  Set r2 = Tabelle1.Range("A:A").CurrentRegion
'  ' sonst geht vieleicht diese Möglichkeit
'  Dim iMaxZeile As Integer  ' größtmögliche Zeilenanzahl
'  iMaxZeile = 20            ' z.B. 20
'  Set r1 = Tabelle1.Range(Cells(1, 10), Cells(iMaxZeile, 10)) 'J1 bis JiMaxZeile
'  Set r2 = Tabelle1.Range(Cells(1, 1), Cells(iMaxZeile, 1))   'A1 bis AiMaxZeile
  
  Set r3 = Tabelle1.Range("G:G")
  Set r4 = Tabelle1.Range("B:B")
  If Vergleich(r1, r2) Then                     ' = beide gleich
    On Error Resume Next
    r3.PasteSpecial = r4.Copy
  Else
    For iZ = 1 To r1.Rows.Count
      r3.Cells(iZ, 1).Value = ""
    Next iZ
  End If
End Sub

Function Vergleich(mR1 As Range, mR2 As Range) As Boolean
  Dim i As Integer
  Dim c1 As Range
  Vergleich = True
  If mR1.Rows.Count <> mR2.Rows.Count Then
    ' Prüfung nur nötig wenn unterschiedliche Zeilenanzahl möglich
    Vergleich = False
    Exit Function
  End If
  i = 1
  For Each c1 In mR1
    If c1.Value <> mR2.Cells(i, 1).Value Then
      Vergleich = False
      Exit Function
    End If
    i = i + 1
  Next
End Function


Ich habe aus Bequemlichkeit zum Testen alles in eine Tabelle gelegt.

Viel Erfolg
Walter Gutermann
 
Danke!
Hab mich gestern noch bisschen gespielt und bin mit folgender Lösung auf ein Ergebniss gekommen das bis jetzt funtzt! Zwar wird es dadurch sehr langsam aber das werde ich hoffentlich auch in den griff bekommen! Falls jemand Besserungen zu diesem Code hat!
BITTE IMMER GERN HER DAMIT

Ansonsten dennoch danke an Euch! & natürlich werde ich Eure möglichkeiten auch noch testen ;-)

ThX Very Much



Code:
 'Neuer versuch
        
        'kopiert Spalte J nach Z
        
    Columns("J:J").Select
    Selection.Copy
    Columns("Z:Z").Select
    ActiveSheet.Paste
    
        '*kopieren Ende
        

Application.OnKey "{ESC}" 'copyauswahl verlieren
        
Range("J:J") = ("=Y1")                  'J1=Y1 autofill fortlaufend
Columns("J:J").Interior.ColorIndex = 6  'stellt Spaltenfarbe auf Gelb

Range("Z2").Select                      'stellt J1 wieder auf standard formatierung
    Selection.Copy
        Range("J2").Select
        ActiveSheet.Paste
        
Range("J1") = ""                        'stellt J1 inhalt auf leer
Range("J1").Interior.ColorIndex = 15    'stellt J1 wieder normal

            Columns("Z:Z").EntireColumn.Hidden = True   'Versteckt Spalte Z
            Columns("Y:Y").EntireColumn.Hidden = True   'Versteckt Spalte Y

'Neuer Versuch * ENDE
 
Zurück