Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
708to712
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Macro Änderung

Macro Änderung
17.12.2005 12:35:36
Gerhard
Hallo
Ich habe in einer Exce Tabelle so eine Art INI Datei geschrieben und mit den Namen
strDateiBestand, strBestandSheets1....... rufe ich Excel Dateien od. Tabellenblätter aus diesen INI Tabellenblatt auf.
Im Grunde habe ich zwei Arbeitsmappen:
1. Kunde Bestand.xls = Datenbank = (strDateiBestand) Sheets1 = (strBestandSheets1)
2. 112005KundeAbrechnung.xls = Monatsabrechnung im Archiv = (strArchivNameXLS) Sheets1 =(strMonatSheets1).
Mit dem Macro habe ich bis jetzt die Einträge der Monatsabrechnung in der Datenbank gesucht und wenn in der Spalte 18 der Datenbank ein Wert eingetragen war habe ich von diesen -1 abgezogen (kann dadurch sagen wie oft die jeweilige Position der Datenbank verwendet wird; Positionen = Werkzeuge). Das funktionierte auch perfekt.
Nun hat sich einiges geändert. Die Positionen die in der Monatsabrechnung drinnen stehen können nun mehrere Stück sein und drum ist der Abzug von -1 nicht mehr richtig. In der Spalte 16 = P habe ich diese Stück angegeben und nun möchte ich dass dieser Wert in der Datenbank Spalte 18 abgezogen wird.
Hänge das Original an das bis jetzt funktioniert hat mit Abzug -1

Sub InsArchiv()
'Aktivierung Monatsrechnung
Call SteuerungAktivierung
Dim strPfadMonBes As String
Dim strPfadArchivM As String
Dim strDateiMonat As String
Dim strMonatSheets1 As String
Dim strMonatSheets2 As String
Dim strMonatSheets6 As String
Dim strDateiBestand As String
Dim strBestandSheets1 As String
strPfadMonBes = Workbooks(strNameSteuerung).Sheets("INI").[B11]
strPfadArchivM = Workbooks(strNameSteuerung).Sheets("INI").[B10]
strDateiMonat = Workbooks(strNameSteuerung).Sheets("INI").[B13]
strMonatSheets1 = Workbooks(strNameSteuerung).Sheets("INI").[B14]
strMonatSheets2 = Workbooks(strNameSteuerung).Sheets("INI").[B15]
strMonatSheets6 = Workbooks(strNameSteuerung).Sheets("INI").[B17]
strDateiBestand = Workbooks(strNameSteuerung).Sheets("INI").[B12]
strBestandSheets1 = Workbooks(strNameSteuerung).Sheets("INI").[B18]
Windows(strDateiMonat).Activate
Sheets(strMonatSheets1).Activate
Call BlattschutzAus
'Dateinamen festlegen Exit möglich
Do
Dim ArchivName As String
Dim EingabeKorrekt As Variant
Dim strArchivNameXLS As String
ArchivName = InputBox("Bitte Dateiname angeben!                                        Format: MMJJJJKaindlabrechnung z.B. 062005Kundeabrechnung")
If Right(ArchivName, 4) = ".xls" Then
ArchivName = Left(ArchivName, Len(ArchivName) - 4)
ElseIf ArchivName = "" Then
MsgBox "Die Monatsabrechnung Übergabe ins Archiv wurden abgebrochen!", vbInformation
Call Blattschutz
Call AbschlussAktivierung
Exit Sub
End If
EingabeKorrekt = ArchivName
Loop Until MsgBox("Ist die Eingabe korrekt? :      " & EingabeKorrekt, vbYesNo + vbQuestion) = vbYes
strArchivNameXLS = ArchivName & ".xls"
ActiveWorkbook.SaveAs Filename:=(strLaufwerk & strPfadMonBes & strPfadArchivM & strArchivNameXLS) _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'Formelumwandlung
Windows(strArchivNameXLS).Activate
Sheets(strMonatSheets1).Activate
Dim SRow As Long
With Sheets(strMonatSheets1)
For SRow = 4 To 582
Cells(SRow, 1).Value = .Cells(SRow, 1)   'Hilfsfeld
Cells(SRow, 2).Value = .Cells(SRow, 2)   'Status
Cells(SRow, 3).Value = .Cells(SRow, 3)   'Pos.
Cells(SRow, 4).Value = .Cells(SRow, 4)   'Werkzeug
Cells(SRow, 5).Value = .Cells(SRow, 5)   'Durchm.
Cells(SRow, 6).Value = .Cells(SRow, 6)   'Breite
Cells(SRow, 7).Value = .Cells(SRow, 7)   'Zähne
Cells(SRow, 8).Value = .Cells(SRow, 8)   'Zeichn. Nr.
Cells(SRow, 9).Value = .Cells(SRow, 9)   'Schneidenart
Cells(SRow, 10).Value = .Cells(SRow, 10) 'Artikelnr.
Cells(SRow, 11).Value = .Cells(SRow, 11) 'Linie Kaindl Bestandsliste
Cells(SRow, 12).Value = .Cells(SRow, 12) 'Satz Stück
Cells(SRow, 13).Value = .Cells(SRow, 13) 'Preis
Cells(SRow, 19).Value = .Cells(SRow, 19) 'Verr. Datum
Cells(SRow, 20).Value = .Cells(SRow, 20) 'Inventur Zustand
Cells(SRow, 21).Value = .Cells(SRow, 21) 'Linie Geliferte Pos.
Cells(SRow, 22).Value = .Cells(SRow, 22) 'Ausgangsdatum
Cells(SRow, 23).Value = .Cells(SRow, 23) 'Verr. Basis
Next
End With
'Tabellenblatt Schärfabrechnung sortieren "N"=IdentNr. , "O"=Nr. , "V"=Eingangsdatum
Sheets(strMonatSheets1).Activate
Range("A3:V583").Select
Selection.Sort Key1:=Range("N4"), Order1:=xlAscending, Key2:=Range("O4") _
, Order2:=xlAscending, Key3:=Range("H4"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Löschen dr Vorlagezellen Zeilen 600 u. 601
Rows("600:601").Select
Selection.Delete Shift:=xlUp
Range("A4").Select
'Formelumwandlung Sheets6
Windows(strArchivNameXLS).Activate
Sheets(strMonatSheets6).Activate
Dim GRow As Long
With Sheets(strMonatSheets6)
For GRow = 587 To 587
Cells(GRow, 6).Value = .Cells(GRow, 6)   'Inventurschärfunge Gesamtbestand Vormonat
Next
End With
'Filter Tabelle Inventurabrechnung Spalte 11 = "K"=Anzahl Schärfungen
Selection.AutoFilter Field:=12, Criteria1:="<>"
Sheets(strMonatSheets1).Activate
'Leitz Bestand ändern in Datenbank
Dim lngErsteZeile As Long, lngLetzteZeile As Long
Dim lnfRowFind As Long, lngZeilen As Long
'Erste Zeile wo es los geht in Monatsabrechnung
lngErsteZeile = 4
' Sucht erste leere Zelle in Spalte A (ab A4), das dann minus 1 ergibt die letzte Zeile
' die bearbeitet werden soll.
lngLetzteZeile = Workbooks(strArchivNameXLS).Sheets(strMonatSheets1).Range("A4:A65536").Find( _
What:="", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext).Row - 1
'lngLetzteZeile = Range("A65536").End(xlUp).Offset(0, 0).Row
For lngZeilen = lngErsteZeile To lngLetzteZeile
lnfRowFind = -1
On Error Resume Next
lnfRowFind = Workbooks(strDateiBestand).Sheets(strBestandSheets1).Range("A:A").Find( _
What:=Workbooks(strArchivNameXLS).Sheets(strMonatSheets1).Cells(lngZeilen, 1).Text, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Row
On Error GoTo 0
If lnfRowFind < 1 Then
MsgBox "Die HilfsfeldSchärfID Nr " & _
Workbooks(strArchivNameXLS).Sheets(strMonatSheets1).Cells(lngZeilen, 1).Text & _
"  ist nicht im Gesamtbestand vorhanden!", vbCritical
Else
With Workbooks(strDateiBestand).Sheets(strBestandSheets1).Cells(lnfRowFind, 18)
If .Value <> "" Then .Value = .Value - 1
End With
End If
Next lngZeilen
'Ende der Leitz Bestandsänderung, speichern u. schliessen
Sheets(strMonatSheets1).Activate
Call Blattschutz
Sheets(strMonatSheets2).Activate
ActiveWorkbook.Save
ActiveWindow.Close
Windows(strDateiBestand).Activate
ActiveWorkbook.Save
ActiveWindow.Close
Call AbschlussAktivierung
End Sub

Kennt sich jemand von Euch mit diesem Macro aus und kann mir beim ändern helfen?
Gruss
Gerhard

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Macro Änderung
17.12.2005 18:19:55
Man
geh aber nicht zum Berti forum wird gelöscht
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige