|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
 Spalten gemäss Vorgabe sortieren und restliche löschen |
22.09.2016 12:33:59 |
Andreas |
|
|
|
22.09.2016 12:41:41 |
Gast91939 |
|
|
|
22.09.2016 12:42:46 |
Gast50732 |
|
|
|
23.09.2016 13:29:28 |
Gast48165 |
|
|
Von:
Andreas |
Datum:
22.09.2016 12:33:59 |
Views:
1314 |
Rating:
|
Antwort:
|
Thema:
Spalten gemäss Vorgabe sortieren und restliche löschen |
|
Hallo zusammen,
ich habe folgendes Problem und kenne mich jedoch mit VBA nicht so gut aus. Habe sehr viel Code aus dem Internet, da diese Thema bereits div. Male diskutiert wurde. Ich möchte aus einer Datei "wbDatei1" das Makro starten. Aus diesem kann ich ein anderes Excel-File öffnen, worin die Spalten gemäss Array-Definition
neu angeordnet werden sollten. Die übrigen Spalten sollten gelöscht werden.
Im weiteren wird die geöffnete Datei formiert. Der Teil der Formatierung sollte meines Wissens korrekt sein.
Ich habe das Problem, dass die gesuchten Texte in der Datei "wbDatei1" erscheinen und nicht wie gewünscht
in der geöffneten Datei angeordnet werden.
Public Sub CommandButtonTest_Click()
Dim WbDatei1 As String
Dim strFilter As String
Dim strFileName As Variant
Dim Pfad As String
Dim wb As Workbook
Dim ws As Worksheet
Dim strSearch As Variant
Dim intColumn As Integer
Dim bytCounter As Byte
Dim rngGefunden As Range
WbDatei1 = ActiveWorkbook.Name
'** 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
Vielen Dank für eure rasche Hilfe
Gruss
Andreas
|
- 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
|
Spalten gemäss Vorgabe sortieren und restliche löschen |
22.09.2016 12:33:59 |
Andreas |
|
|
|
22.09.2016 12:41:41 |
Gast91939 |
|
|
|
22.09.2016 12:42:46 |
Gast50732 |
|
|
|
23.09.2016 13:29:28 |
Gast48165 |
|
|