MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 19.01.2018, 08:04   #1
Janspitzi
Neuer Benutzer
Neuer Benutzer
Tipp VBA - Makro zusammenführung

guten Morgen/guten Tag,

vorab gesagt ich bin kein Excel profi!
den Code den ich unten angehangen habe, habe ich mir aus viel Foren zusammen gebastelt und habe nun in den letzten Tagen von euch bei einem sehr gute Hilfe bekommen, jedoch will ich den neuen Code von euch nun in meinen bestehenden einarbeiten, jedoch klappt das an manchen stellen nicht bzw, an manchen stellen müsste ich Ihn umschreiben, jedoch habe ich immer wieder Fehler..

ich bitte daher nochmals um eure Hilfe

Code:

'-----------------------------------------------------------------------------------------------------------------------
' Autor: Jan 
'
' Wid beim Öffnen der Mappe automatisch abgearbeitet....
'
'-----------------------------------------------------------------------------------------------------------------------
Private Sub Workbook_Open()

   StartErsetzung
   
End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Autor: Jan 
'
' Steuerungsmethode
'
'-----------------------------------------------------------------------------------------------------------------------
Sub StartErsetzung()
     
    ' Dimensionierung der Variablen
    Dim wb As Workbook
    Dim strFileName
    Dim strFilter As String
     
    ' Dateifilter definieren
    strFilter = "Excel-Dateien(*.xl*), *.xl*"
     

    strFileName = "Tabelle B.xlsx"


If 1 = 2 Then
    
    
    ' Den im Dialogfeld gewählten Namen auslesen
    strFileName = Application.GetOpenFilename(strFilter)
     
     
    ' Prüfen, ob eine gültige Datei ausgewählt wurde
    If strFileName = False Then
        Exit Sub
    End If
     


     
    ' Gewählte Datei öffnen
    Set wb = Workbooks.Open(strFileName)
    If wb Is Nothing Then
        Application.Quit
        Exit Sub
    End If
   
    ' Spalten Prüfen
    If Not PruefeSpalten(wb) Then
        VerwerfeWorkBook wb
        Application.Quit
        Exit Sub
    End If
    
    ' Adressen teilen
    If Not AdressenTeilen(wb) Then
        VerwerfeWorkBook wb
        Application.Quit
        Exit Sub
    End If
    
End If
    
    ' Sachbaerbeiterangaben belegen
    If Not SetzeSBAngaben(wb) Then
        VerwerfeWorkBook wb
        Application.Quit
        Exit Sub
    End If
    
If 1 = 2 Then
    
    
    ' Mappe Speichern
    SpeichernWorkBook (wb)

End If


End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Autor: Jan 
'
' SB anhand der GKz identifizieren und zu ordnen
'
'-----------------------------------------------------------------------------------------------------------------------
Function SetzeSBAngaben(wb As Workbook) As Boolean

    SetzeSBAngaben = True


    Dim z As Long
    Dim lz As Long, LS As Long
    Dim s As Integer, IntSpalte As Integer


    'Das bräuchte ich ja nicht ich weiß nur nicht wie ich excel
    nun sage das er strFilename schon die offene Tabelle nehmen soll
    'Dim strFilename As String: strFilename = "K:JanExcelTabelle B.xlsx" 

       Dim WBEintragen As Workbook: Set WBEintragen = ThisWorkbook
       Dim WBSuche As Workbook: Set WBSuche =         
       Workbooks.Open(Filename:=strFilename)


With WBEintragen.Worksheets("Ziel")
    lz = .Cells(Rows.Count, 1).End(xlUp).Row
    LS = .Cells(1, Columns.Count).End(xlToLeft).Column
    
        For z = 1 To lz
            For IntSpalte = 1 To 6
                     Hier sagt er mir immer das der Index außerhalb 
                     des Gültigen bereichtrs liegt
                .Cells(z, LS + IntSpalte).Value = WorksheetFunction.VLookup(.Cells(z, 7).Value, WBSuche.Worksheets("Sachbearbeiter").Range("A:G"), IntSpalte + 1, False)
            Next IntSpalte
        Next z
End With


'-----------------------------------------------------------------------------------------------------------------------
' Autor: Jan 
'
' Eine übergebene Spalte im übergebnen Workbook dort in Worksheet 1 suchen,
' Rückgabe = Range
'
'-----------------------------------------------------------------------------------------------------------------------
Function PruefeSpalten(wb As Workbook) As Boolean

    PruefeSpalten = True
    
    Dim rng As Range
    
    ' Spalte mit den Betriebsstättendaten suchen
    Set rng = SucheSpalte(wb, "F_09")
    If rng Is Nothing Then
    
        ' Spalte nicht gefunden
        MsgBox "Die Spalte F_09 (Betriebsstätte) wurde nicht gefunden, bitte im PC-KLAUS Export einstellen!" & vbCrLf & vbCrLf & "Die Umwandlung wird beendet."
        PruefeSpalten = False
        Exit Function
    
    End If
    
    ' Spalte mit den Betriebsstättendaten suchen
    Set rng = SucheSpalte(wb, "Gemeindekennzahl")
    If rng Is Nothing Then
    
        ' Spalte nicht gefunden
        MsgBox "Die Spalte Gemeindekennzahl wurde nicht gefunden, bitte im PC-KLAUS Export einstellen!" & vbCrLf & vbCrLf & "Die Umwandlung wird beendet."
        PruefeSpalten = False
        Exit Function
    
    End If

End Function


'-----------------------------------------------------------------------------------------------------------------------
' Autor: Jan 
' Speichern der Mappe
'
'-----------------------------------------------------------------------------------------------------------------------
Function SpeichernWorkBook(wb As Workbook) As Boolean

    MsgBox "Speichern"
    SpeichernWorkBook = True

End Function

'-----------------------------------------------------------------------------------------------------------------------
' Autor: Jan 
'
' Verwerfen der Mappe
'
'-----------------------------------------------------------------------------------------------------------------------
Function VerwerfeWorkBook(wb As Workbook) As Boolean

    wb.Close (False)
    VerwerfeWorkBook = True

End Function


'-----------------------------------------------------------------------------------------------------------------------
' Autor: Jan 
'
'Spalte Adressen Teilen, es wird hier davon ausgegengen, dass die Adresse im Format:
'
'       Straße Nr, PLZ Ort
'
' in der Spalte F_09 zu finden ist. Die Adresse wird in 2 neue Spalten gesplittet, die am Ende der Spalten angehangen
' werden. Sie neuen Spalten bekommen die Bezeichnung Straße und Ort
'
'
' Paramter:
'   wb => geöffnete Excel Tabelle
'
' Rückgabe:
'   True oder False je nach Lage
'
'-----------------------------------------------------------------------------------------------------------------------
Function AdressenTeilen(wb As Workbook) As Boolean

    ' Default Rückgabe
    AdressenTeilen = True
    
    ' Benötigte Variablen deklarieren
    Dim rng As Range
    Dim rngNew As Range
    
    ' Spalte mit den Betriebsstättendaten suchen
    Set rng = SucheSpalte(wb, "F_09")
    
    ' Etwas gefunden?
    If Not rng Is Nothing Then
        
        ' Markiere die Spalte in der die zu teilenden Daten stehen
        Columns(rng.Column).Select
        
        ' Ermittlung der nächsten Spalte, die keine Überschrift hat
        Set rngNew = SucheSpalte(wb, "")
        ' Nun in Buchstabenkombination wandeln
        Dim cSpalte As String
        cSpalte = Chr(64 + rngNew.Column) + "1"
    
    
        ' Neue Spalten belegen
        Selection.TextToColumns Destination:=Range(cSpalte), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
                :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

    
        ' Überschrift der neuen Straßenspalte belegen
        rngNew.Value = "Straße"
        
        ' Die nächste leere Spalte ist doe PLU Ort Spalte suchen und *Überschrift belegen
        Set rngNew = SucheSpalte(wb, "")
        rngNew.Value = "Ort"
    
    End If
    


End Function

'-----------------------------------------------------------------------------------------------------------------------

' Autor: Jan
'
' Eine übergebene Spalte im übergebnen Workbook dort in Worksheet 1 suchen,
' Rückgabe = Range
'
'-----------------------------------------------------------------------------------------------------------------------
Function SucheSpalte(wb As Workbook, cSeek As String) As Range

    Set SucheSpalte = Nothing
    Dim rng As Range
    
    With wb.Worksheets(1).Range("A1:Z1")
        
        Set rng = .Find(What:=cSeek, _
                        After:=.Cells(1), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        
        If Not rng Is Nothing Then
            Set SucheSpalte = rng
        End If
    
   End With

End Function
hoffe ihr könnt mir da aushelfen.

Die Ausgangs situation soll am ende so sein:

Einer hat die Tabelle A und bekommt nun eine Tabelle B, in Tabelle B möchte er nun alle angaben aus A passend zu den Fällen haben. Damit er das an einen weiteren schickt der aus Tabelle B nun einen Serienbrief in Word erstellen kann.

Mit freundlichen Grüßen

Jan
Angehängte Dateien
Dateityp: xlsm Tabelle A.xlsm (29,2 KB, 0x aufgerufen)
Dateityp: xlsx Tabelle B.xlsx (10,3 KB, 0x aufgerufen)
Janspitzi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 21.01.2018, 09:52   #2
Hajo_Zi
MOF Guru
MOF Guru
Standard

nur mal teil 1

Zitat:

'Das bräuchte ich ja nicht ich weiß nur nicht wie ich excel
nun sage das er strFilename schon die offene Tabelle nehmen soll
'Dim strFilename As String: strFilename = "K:JanExcelTabelle B.xlsx"

eine offene Tabelle ist keine Datei.

Falls Dateiname der offenen Datei mit dem Makro.
ThisWorkbook.Name

GrußformelHomepage

__________________

Signatur in jedem Beitrag
m Forum kann der Beitrag als erledigt markiert werden. Also mache es unten links mit Klick auf den Schalter "als erledigt setzen", falls Problem gelöst.
Der Zustand des Beitrages wird dann in der Übersicht angezeigt und man braucht sich diese Beiträge nicht mehr ansehen.
Bitte Version angeben. Bei keiner Angabe gehe ich von meinen Angaben aus.
Betriebssystem: Windows 10 - 64 Bit, Office 2016 - 32 Bit.

Geändert von Hajo_Zi (21.01.2018 um 09:56 Uhr).
Hajo_Zi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 21.01.2018, 13:15   #3
R J
MOF Meister
MOF Meister
Standard

Hi Jan,

ich denke, Du solltest Dich, bevor Du Projekte startetst, sinnvollerweise mit den Basics befassen. Schon allein deshalb, damit Dir solch elementare Fehler, wie in Deinem Code, nicht mehr unterlaufen.
2 Beispiele:

1._
Code:

If 1 = 2 Then
Kannst Du mir auch nur einen einzigen Fall nennen, bei dem diese Bedingung zutreffen könnte?

2.:

Zitat:

'....
End With


'-----------------------------------------------------------------------------------------------------------------------
' Autor: Jan
'
' Eine übergebene Spalte im übergebnen Workbook dort in Worksheet 1 suchen,
' Rückgabe = Range
'
'-----------------------------------------------------------------------------------------------------------------------
Function PruefeSpalten(wb As Workbook) As Boolean

Allein in Function SetzeSBAngaben(wb As Workbook) As Boolean springt der Debugger mehrmals an und markiert sogar die Stellen, die er für falsch hält. Wenigstens die nicht auskommentierte Kommentarzeile hätte Dir auffallen müssen (na gut, die hast Du vielleicht nur hier in diesen Post eingefügt....). Aber, dass diese Funktion nicht mit End Function beendet wird., hätte Dir mit Basiskenntnissen auffallen müssen.
Sorry, aber ich sehe für mich keinen Sinn darin, bei Fehlen elementarster Kenntnisse, die Defizite ausbügeln zu sollen. Da bist in erster Linie Du selbst gefragt. Bei Verständnisproblemen oder dem berühmten Brett vor dem Kopf, da helfe ich Dir (und anderen) aber gern weiter.

__________________

Ciao, Ralf

Auf, zum Markplatz der Ideen!
Der sicherste Ansatz für einen Irrtum ist der Glaube, alles im Griff zu haben.
Nur, weil ich den Recorder bedienen kann, macht mich das noch lange nicht zum Musiker.


R J ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:40 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.