|
Hallo liebes Forum,
ich bin ziemlicher Neuling im Bereich VBA und habe nun eine für meine Kenntnisse sehr ausführliche Aufgabe bekommen. Ich habe mich bereits etwas voran gerarbeitet mit Hilfe dieses und anderer Foren und verschiedener Bücher. Dennoch bin ich nicht wirklich zu frieden.
Meine Aufgabe und die drei benötigten Dateien habe ich in dieser Datei zusammengefasst:
[url]https://rapidshare.com/files/3884808837/VBA.zip[/url]
Im Prinzip geht es um folgende Schritte:
1. Das Format der Datei 1(Datei ist bereits vorhanden) soll geändert werden, die Zeilen sollen nach dem Wert in der Spalte Refcon aufsteigend sortiert werden, 2 Zellen sollen Formatiert werden und 5 Kriterien hinzugefügt werden.
2. In der Datei 2(Datei ist bereits vorhanden) sollen 2 Zellen formatiert werden.
3. Werte (varierend viele, d.h. es sollen jeweils die Werte verglichen werden, die an einem Tag X eingegangen sind, der Tag X soll per MsgBox erfragt werden) aus der Datei 1 sollen mit entsprechenden Werten der Datei 2 (Referenzwerte, d.h. vom Tag X mit passender ID) verglichen werden. Das Ergebnis soll in einer Datei 3(Datei ist bereits vorhanden) ausgegeben werden.
Meine Probleme basieren darauf, dass der Makrorekorder zu statisch ist und ich zu wenig Kenntnis in Excel selbst habe, um es richtig zu lösen.
Konkret:
Zu 1.:
a) Wie kann ich dynamisch die Zeilen nach dem Wert der Spalte Refcon sortieren lassen. Mit dem Makrorekorder wirkt das leider sehr statisch?
b) Kann ich das Suchen und darauffolgende Formatieren von Spalten "schöner" lösen?
Zu 2.:
a) s. 1. b) (zum Thema suchen und Finden: Ich möchte hier "Cashflow" finden, aber nicht Cashflowtype, daher suche ich einfach einmal "weiter" -> nicht so optimal)
Zu 3.:
Im Grunde weiß ich hier bisher gar nicht weiter. Der Makrorekorder ist wieder so statisch, dass z.B. bei Änderung der Dateinamen alles murks ist.
Geschrieben habe ich dazu bisher Folgendes:
[code]Sub Berg1()
'
' Berg1 Makro
'
'Datei1 auswählen
MsgBox "Datei 1 auswählen"
ChDrive "N:\"
dateiname = Application.GetOpenFilename
If dateiname = False Then Exit Sub 'oder GoTo Omega zum Zurückstellen der Excel-Einstellungen
Workbooks.Open Filename:= _
dateiname
dateiNeu = ActiveWorkbook.Name ' Name des Datenabzug
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook
'Refcon finden & formatieren
Cells.Find(What:="refcon", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Columns(ActiveCell.Column).Select
Selection.NumberFormat = "0"
Select.Range
ActiveWorkbook.Worksheets("Datei 1").Sort.SortFields. _
Add Key:=Range("E2:E6074"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Datei 1").Sort
.SetRange Range("A1:W6074")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Quantity finden & formatieren
Cells.Find(What:="quantity", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Columns(ActiveCell.Column).Select
Selection.NumberFormat = "#,##0"
'Amount finden & formatieren
Cells.Find(What:="Amount", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Columns(ActiveCell.Column).Select
Selection.NumberFormat = "#,##0.00"
'Kommentar hinzufügen und formatieren
Range("X1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Kommentar"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Hinweis hinzufügen und formatieren
Range("Y1").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Hinweis"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Bearbeitet hinzufügen und formatieren
Range("Z1").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Bearbeitet"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Kategorie hinzufügen und formatieren
Range("AA1").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Kategorie"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'zuletzt geprüft hinzufügen und formatieren
Range("AB1").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = -16777216
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "zuletzt geprüft"
With ActiveCell.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Datei1 zuweisen
Set w = ActiveWorkbook
'Datei2 öffnen
MsgBox "Datei 2 auswählen"
ChDrive "N:\"
dateiname = Application.GetOpenFilename
If dateiname = False Then Exit Sub 'oder GoTo Omega zum Zurückstellen der Excel-Einstellungen
Workbooks.Open Filename:= _
dateiname
dateiNeu = ActiveWorkbook.Name ' Name des Datenabzug
'Principal finden und formatieren
Cells.Find(What:="Principal", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Columns(ActiveCell.Column).Select
Selection.NumberFormat = "#,##0"
'Cashflow (nicht Cashflowtype) finden und formatieren
Cells.Find(What:="CashFlow", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
Columns(ActiveCell.Column).Select
Selection.NumberFormat = "#,##0.00"
Set e = ActiveWorkbook
'Zurück zu Datei1
w.Activate
End Sub
[/code]
Ich hoffe, dass ihr mir weiterhelfen könnt.
Ich weiß, es ist ne ganze Menge, aber ich bin wirklich am Ende mit meinem Laienhalbwissen.
Danke in jedem Fall an jeden schon ein mal, der sich überhaupt die Mühe gemacht hat, bis hierhin zu lesen.
Grüße,
Max
|