Herbers Excel-Forum - das Archiv

Anpassung

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

Die Datei https://www.herber.de/bbs/user/19835.xls wurde aus Datenschutzgründen gelöscht

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
Excel-Beispiele zum Thema "Anpassung"
Farbanpassung nach Eingabewert Terminplananpassung bei Änderung des Kalenderjahres
Anpassung des Lagerbestands bei Ein- und Ausgang