Anpassung

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Anpassung
von: artur
Geschrieben am: 18.03.2005 13:27:00
Hallo Leute (Chris),
habe ein Code welcher auf folgende Mappe abgestimmt ist
https://www.herber.de/bbs/user/19834.xls
nun hat sich meine mappe geändert uns sieht so aus
https://www.herber.de/bbs/user/19835.xls
und der code funktioniert nicht mehr, was muss ich genau anpassen


Sub Vergleichen()
    Dim LoI As Long
    Dim LoJ As Long
    Dim LoLetzte1 As Long
    Dim LoLetzte2 As Long
    Dim Loletzte3 As Long
    Dim c As Object
    Dim z%
    
    With Worksheets("Verweis")
        LoLetzte1 = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row, 65536)
    End With
    With Worksheets("sheet1")
        LoLetzte2 = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
    End With
    For LoI = 1 To LoLetzte1
            ' Leerzellen nicht kennzeichnen
            Set c = Worksheets("Übersicht").Columns(1).Find(what:=Worksheets("Verweis").Cells(LoI, 1).Value, lookat:=xlWhole)
            If Worksheets("Verweis").Cells(LoI, 1).Value <> "" And c Is Nothing Then
                Set c = Worksheets("sheet1").Columns(2).Find(what:=Worksheets("Verweis").Cells(LoI, 1).Value, lookat:=xlWhole)
                If Not c Is Nothing Then
                    startzeile = LoI
                    summe = Worksheets("Verweis").Cells(LoI, 2).Value
                    z = 1
                    zeile = LoI
                    Do
                        Set c = Worksheets("Verweis").Columns(1).Find(what:=Worksheets("Verweis").Cells(LoI, 1), after:=Worksheets("Verweis").Cells(zeile, 1), lookat:=xlWhole)
                        If c.Row <> startzeile Then
                            summe = summe + Worksheets("Verweis").Cells(c.Row, 2).Value
                            z = z + 1
                            zeile = c.Row
                        End If
                    Loop Until c.Row = startzeile
                    
                    Worksheets("Verweis").Rows(LoI).Copy
                    With Worksheets("Übersicht")
                        Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                        
                        If Loletzte3 > 65536 Then
                            MsgBox "In Tabelle3 ist keine Zeile mehr frei"
                            Application.CutCopyMode = False
                            Exit Sub
                        End If
                        
                        .Rows(Loletzte3).PasteSpecial Paste:=xlValues           ' Werte
                        .Rows(Loletzte3).PasteSpecial Paste:=xlFormats      ' Formate
                        .Cells(Loletzte3, 2).Value = summe
                        .Cells(Loletzte3, 3).Value = z
                    End With
                End If
            End If
    Next LoI
    Application.CutCopyMode = False
End Sub

Vielen,vielen Dank
MFG
Artur
Bild

Betrifft: AW: Anpassung
von: ChrisSp
Geschrieben am: 18.03.2005 13:36:50
Hi Artur,
so sieht man sich wieder :o)
Also das erste ist, dass du die Namen der Arbeitsmappen "Verweis" und "sheet1" vertauscht hast! Wenn das beabsichtigt ist, musst du das auch im Makro machen!!!
Außerdem hast du die Spalten geändert, d.h. du musst die Spalten im code entsprechend anpassen!
zur Erinnerung :o) *Cells(*Zeilennummer*,*Spaltennummer*)*
Gruss
Chris
Bild

Betrifft: AW: Anpassung
von: artur
Geschrieben am: 18.03.2005 13:39:34
Hi Chris, super das du noch da bist,
habe das folgendermaßne geändert, aber es läuft trotzdem nicht????

Sub Vergleichen()
    Dim LoI As Long
    Dim LoJ As Long
    Dim LoLetzte1 As Long
    Dim LoLetzte2 As Long
    Dim Loletzte3 As Long
    Dim c As Object
    Dim z%
    
    With Worksheets("Verweis")
        LoLetzte1 = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row, 65536)
    End With
    With Worksheets("sheet1")
        LoLetzte2 = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
    End With
    For LoI = 1 To LoLetzte1
            ' Leerzellen nicht kennzeichnen
            Set c = Worksheets("Übersicht").Columns(1).Find(what:=Worksheets("sheet1").Cells(LoI, 2).Value, lookat:=xlWhole)
            If Worksheets("Verweis").Cells(LoI, 1).Value <> "" And c Is Nothing Then
                Set c = Worksheets("verweis").Columns(1).Find(what:=Worksheets("sheet1").Cells(LoI, 2).Value, lookat:=xlWhole)
                If Not c Is Nothing Then
                    startzeile = LoI
                    summe = Worksheets("sheet1").Cells(LoI, 3).Value
                    z = 1
                    zeile = LoI
                    Do
                        Set c = Worksheets("sheet1").Columns(2).Find(what:=Worksheets("sheet1").Cells(LoI, 2), after:=Worksheets("sheet1").Cells(zeile, 2), lookat:=xlWhole)
                        If c.Row <> startzeile Then
                            summe = summe + Worksheets("sheet1").Cells(c.Row, 3).Value
                            z = z + 1
                            zeile = c.Row
                        End If
                    Loop Until c.Row = startzeile
                    
                    Worksheets("Verweis").Rows(LoI).Copy
                    With Worksheets("Übersicht")
                        Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                        
                        If Loletzte3 > 65536 Then
                            MsgBox "In Tabelle3 ist keine Zeile mehr frei"
                            Application.CutCopyMode = False
                            Exit Sub
                        End If
                        
                        .Rows(Loletzte3).PasteSpecial Paste:=xlValues           ' Werte
                        .Rows(Loletzte3).PasteSpecial Paste:=xlFormats      ' Formate
                        .Cells(Loletzte3, 2).Value = summe
                        .Cells(Loletzte3, 3).Value = z
                    End With
                End If
            End If
    Next LoI
    Application.CutCopyMode = False
End Sub

MFG
Artur
Bild

Betrifft: AW: Anpassung
von: ChrisSp
Geschrieben am: 18.03.2005 13:45:58
Hi Artur,
bin aber nicht mehr lange hier - WOCHENENDE :o)))
... evtl. liegt es daran, dass du in der Mitte einmal "verweis" statt "Verweis" geschrieben hast, wenn nicht, beschreib mal wo genau der Fehler auftritt und wie die Fehlermeldung ist
Gruss
Chris
Bild

Betrifft: Außerdem...
von: ChrisSp
Geschrieben am: 18.03.2005 13:48:48
hast du bei der Ermittlung von *LoLetzte1* und *LoLetzte2* die Bezeichungen der Tabellenblätter nicht anpasst
Gruss
Chris
Bild

Betrifft: AW: Außerdem...
von: artur
Geschrieben am: 18.03.2005 13:53:05
Hi Chris,
ich hoff wir schaffen das noch vor dem WE
die Bezeichnung hier ist je *LoLetzte1* und *LoLetzte2* richtig.
Es wurde ja ab *For LoI=1 ... was verändert.
Es kommt keine Fehlermeldung nur er rechnet nicht, oder falsch
siehe hier
https://www.herber.de/bbs/user/19837.xls
MFG
Artur
Bild

Betrifft: ...Schreib in einer Std. nochmal...
von: ChrisSp
Geschrieben am: 18.03.2005 13:59:27
... muss kurz zu nem Meeting
gruss
Bild

Betrifft: ...UND...
von: ChrisSp
Geschrieben am: 18.03.2005 13:53:54

die Zeile:
*If Worksheets("Verweis").Cells(LoI, 1).Value <> "" And c Is Nothing Then*
muss heissen:
* If Worksheets("sheet1").Cells(LoI, 1).Value <> "" And c Is Nothing Then*
und die Zeile:
*Worksheets("Verweis").Rows(LoI).Copy*
lautet:
*Worksheets("sheet1").Rows(LoI).Copy*
- ich meinte eigentlich, dass du alle Bezeichnungen anpassen musst, da sonst die Bezüge halt falsch sind, wenn sich die Namen ändern!
Gruss
Chris
Bild

Betrifft: AW: ...UND...
von: artur
Geschrieben am: 18.03.2005 14:05:31
Hi Chris,
ich mach seit einer Stunde nichts anderes wie die Namen Verweis und sheet1 in den Bezügen zu ändern, aber es klappt einfach nicht,kannst du bitte mal testen.
MFG
artur
Bild

Betrifft: Bin wieder da, aber nicht mehr lange :o)
von: ChrisSp
Geschrieben am: 18.03.2005 15:09:18
Hi Artur,
ich glaube, du darfst dich niemals in Berlin blicken lassen - sonst müsstest du mich auf ´ne Bier einladen!!! :o)
Aber nun zu den wirklich wichtigen Dingen des Lebens - EXCEL und MAKROS!!!

Sub Vergleichen()
    Dim LoI As Long
    Dim LoLetzte1 As Long
    Dim Loletzte3 As Long
    Dim c As Object
    Dim z%
    
    With Worksheets("sheet1")
        LoLetzte1 = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
    End With
    For LoI = 1 To LoLetzte1    'Sheet1 wird durchlaufen und mit Verweis verglichen!!!
            ' Leerzellen nicht kennzeichnen
            Set c = Worksheets("Übersicht").Columns(2).Find(what:=Worksheets("sheet1").Cells(LoI, 2).Value, lookat:=xlWhole)
            If Worksheets("sheet1").Cells(LoI, 2).Value <> "" And c Is Nothing Then
                Set c = Worksheets("Verweis").Columns(1).Find(what:=Worksheets("sheet1").Cells(LoI, 2).Value, lookat:=xlWhole)
                If Not c Is Nothing Then
                    startzeile = LoI
                    summe = Worksheets("sheet1").Cells(LoI, 3).Value
                    z = 1
                    zeile = LoI
                    Do
                        Set c = Worksheets("sheet1").Columns(2).Find(what:=Worksheets("sheet1").Cells(LoI, 2), after:=Worksheets("sheet1").Cells(zeile, 2), lookat:=xlWhole)
                        If c.Row <> startzeile Then
                            summe = summe + Worksheets("sheet1").Cells(c.Row, 3).Value
                            z = z + 1
                            zeile = c.Row
                        End If
                    Loop Until c.Row = startzeile
                    
                    Worksheets("sheet1").Rows(LoI).Copy
                    With Worksheets("Übersicht")
                        Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                        
                        If Loletzte3 > 65536 Then
                            MsgBox "In Tabelle3 ist keine Zeile mehr frei"
                            Application.CutCopyMode = False
                            Exit Sub
                        End If
                        
                        .Rows(Loletzte3).PasteSpecial Paste:=xlValues           ' Werte
                        .Rows(Loletzte3).PasteSpecial Paste:=xlFormats      ' Formate
                        .Cells(Loletzte3, 3).Value = summe
                        .Cells(Loletzte3, 4).Value = z
                    End With
                End If
            End If
    Next LoI
    Application.CutCopyMode = False
End Sub

Hat mich echt viel Mühe gekostet!!!
Gruss
Chris
Bild

Betrifft: AW: Bin wieder da, aber nicht mehr lange :o)
von: artur
Geschrieben am: 18.03.2005 15:56:51
Hi Chris,
du warst heute echt mein Retter, ich komm aus mainz, aber wenn ich mal in Berlin bin, dann ist ein Bier auf jeden fall fällig.
Es läuft super, danke dir
MFG
Artur
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Anpassung"