Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
584to588
584to588
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Anpassung

Anpassung
18.03.2005 13:27:00
artur
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

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Anpassung
18.03.2005 13:36:50
ChrisSp
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
AW: Anpassung
18.03.2005 13:39:34
artur
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
Anzeige
AW: Anpassung
18.03.2005 13:45:58
ChrisSp
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
Außerdem...
18.03.2005 13:48:48
ChrisSp
hast du bei der Ermittlung von *LoLetzte1* und *LoLetzte2* die Bezeichungen der Tabellenblätter nicht anpasst
Gruss
Chris
AW: Außerdem...
18.03.2005 13:53:05
artur
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
Anzeige
...Schreib in einer Std. nochmal...
18.03.2005 13:59:27
ChrisSp
... muss kurz zu nem Meeting
gruss
...UND...
18.03.2005 13:53:54
ChrisSp
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
AW: ...UND...
18.03.2005 14:05:31
artur
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
Anzeige
Bin wieder da, aber nicht mehr lange :o)
18.03.2005 15:09:18
ChrisSp
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
Anzeige
AW: Bin wieder da, aber nicht mehr lange :o)
18.03.2005 15:56:51
artur
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige