|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
22.09.2016 12:33:59 |
Andreas |
|
|
|
22.09.2016 12:41:41 |
Gast91939 |
|
|
 Spalten gemäss Vorgabe sortieren und restliche löschen |
22.09.2016 12:42:46 |
Gast50732 |
|
|
|
23.09.2016 13:29:28 |
Gast48165 |
|
|
Von:
Gast50732 |
Datum:
22.09.2016 12:42:46 |
Views:
679 |
Rating:
|
Antwort:
|
Thema:
Spalten gemäss Vorgabe sortieren und restliche löschen |
|
'** Laufwerk und Pfad definieren, welcher geöffnet werden soll
Pfad = "\\XXXXXXX\" ' muss noch angegeben werden
'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xls*), *.xls*"
'** Den im Dialogfeld gewählten Namen auslesen
Set fd = Application.FileDialog(msoFileDialogOpen)
fd.InitialFileName = Pfad & Year(Now()) & "\offen Posten zur Zahlung\"
If fd.Show <> -1 Then
Exit Sub
End If
strFileName = fd.SelectedItems(1)
Set ws = Workbooks.Open(strFileName).Sheets("Format")
ws.Activate
Application.ScreenUpdating = False
Sheets("Format").Select
strSearch = Array("Betrag", "Tariftyp", "Steuerkennzeichen", "MwSt.-Nr.", "Abrechnungsdatum", "Druckbelegnummer", _
"Adresse Partner", "Name Partner", "Vertragskonto", "Geschäftspartner") ' Die einzelnen Spalten werden in umgekehrter Reihenfolge in ein Array geschrieben
For bytCounter = LBound(strSearch) To UBound(strSearch)
Set rngGefunden = Rows("1:1").Find(What:=strSearch(bytCounter), _
After:=Cells(1, Columns.Count), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not rngGefunden Is Nothing Then
If rngGefunden.Columns <> bytCounter + 1 Then
Columns(rngGefunden.Columns).Cut
Columns(bytCounter + 1).Insert Shift:=xlToRight
End If
Else
Columns(bytCounter + 1).Insert Shift:=xlToRight
Cells(1, bytCounter + 1) = strSearch(bytCounter)
End If
Next bytCounter
Application.CutCopyMode = False
ActiveSheet.Columns("K:Z").Delete 'restliche Spalten löschen
'Seite einrichten
With ActiveSheet.PageSetup 'Seite einrichten
preLayout = .Orientation
preZoom = .Zoom
.Orientation = xlLandscape 'Querformat
.FitToPagesWide = 1 '1 Seite breit
.FitToPagesTall = False '"leer" hoch
.PrintTitleRows = "$1:$1" ' Wiederholungszeilen oben
End With
Columns("A:J").EntireColumn.AutoFit 'Spaltenbreite automatisch anpassen
Application.ScreenUpdating = True
End Sub
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
22.09.2016 12:33:59 |
Andreas |
|
|
|
22.09.2016 12:41:41 |
Gast91939 |
|
|
Spalten gemäss Vorgabe sortieren und restliche löschen |
22.09.2016 12:42:46 |
Gast50732 |
|
|
|
23.09.2016 13:29:28 |
Gast48165 |
|
|