Excel: Wenn Wert in Zelle WAHR, dann Entsprechung in Matrix suchen?

Hallo zusammen,

ich habe eine Excel-Liste mit Personen. In Spalte A sind die Personalnummern, in Spalte T wird ausgegeben, ob eine Schwerbehinderung vorliegt. Dies bezieht sich auf ein separates Arbeitsblatt, in welchem Personaldaten mit schwerbehinderten Beschäftigten enthalten sind (Spalte A = Personalnummer). Diese Rückmeldung klappt; hierbei wird einfach geschaut ob die Personalnummer aus Spalte A auch in Spalte A in dem separaten Arbeitsblatt vorkommt. Wenn jemand eine Schwerbehinderung hat, so erscheint "WAHR" in der jeweiligen Zelle in Spalte T.

In Spalte U soll nun ausgegeben werden, ob eine Erwerbsminderungsrente vorliegt. Dies ist i.d.R. nur bei Schwerbehinderten der Fall, sodass hier wieder auf das separate Arbeitsblatt Bezug genommen werden soll.

Es soll also in der Formel für Spalte U die Bedingung gelten, dass wenn in der jeweiligen Zelle in Spalte T "WAHR" steht, dann soll in dem separaten Arbeitsblatt in der dazugehörigen Zeile mit der entsprechenden Personalnummer auf Spalte R verwiesen werden. In Spalte R des separaten Arbeitsblattes ist mit "WAHR" (liegt vor) und "FALSCH" (liegt nicht vor) hinterlegt, ob eine Erwerbsminderungsrente vorliegt.

Gewünscht ist auch ein Verweis auf Spalte S im separaten Arbeitsblatt, wo das Datum hinterlegt ist, wie lange die Rente geht.

Ich probiere seit Ewigkeiten rum, aber kriege es mit einer Formel nicht abgebildet.
Kann jemand helfen? Im Voraus vielen Dank.

Microsoft Excel, Excel 2010, Microsoft Office, VBA, Excel 2007, Formel, Tabellenkalkulation, Tabelle, Excel-Formel, Excel 2013
Gibt es eine Möglichkeit in Excel per VBA mehrere Blätter optional auswählbar in eine PDF zu exportieren?

Hallo Zusammen,

ich suche eine Möglichkeit aus einer Excel Datei (MS 365 auf einem mac) mit mehreren Tabellenblättern dem Nutzer die Möglichkeit zu geben eine PDF zu generieren deren Inhalt und dessen Ablageort er selber definieren kann.

Dabei ist die Auswahl des Inhalts auf die Tabellenblätter begrenzt. In jedem relevanten Tabellenblatt ist je ein Druckbereich definiert. D.h. der Nutzer kann (ohne Makro) auswählen ob er Tabellenblatt 1, Tabellenblatt 4 und oder andere Tabellenblätter drucken will.

Das Makro wird durch einen Button ausgelöst und folgendes geschieht:

  • Abfrage welcher Speicherort und Dateiname
  • Speichern der Datei / Schließen des Fensters
  • Öffnen der generierten PDF Datei

Als Idee hatte ich zunächst mit Checkboxen zu arbeiten. Leider ist auf einem Mac die Nutzung von UserForms nicht möglich.
Die nächste Idee war die Checkboxen für jedes Blatt einzeln auswählbar zu machen.
Am Ende habe ich mich aber dafür entschieden, in einem Feld (aktuell auf jedem Blatt A1) die Information "print" abzulegen, so dass das Makro per Schleife alle Blätter auf A1="print" durchlaufen soll.

da ich noch ziemlicher VBA-Laie bin und mir mein Makro aus verschiedenen im netz verfügbaren Makros zusammengebaut habe, erspare ich euch das Pasten des sicherlich gruseligen Versuchs meinerseits

Leider klappts alles nicht so wie ich das gerne hätte, so dass ich nun auf eure Hilfe hoffe...

Danke schonmal!!

Microsoft Excel, PDF, VBA
Wie erstelle ich sql String zum Füllen des Kombinationsfelds?

Hallo,

ich versuche gerade Access zu verstehen und habe nun ein Problem.

Ich habe zwei Kombinationsfelder:

  1. KombiFeld01
  2. KombiFeld02

Das zweite Kombinationsfeld soll abhängig von der Auswahl vom ersten Kombinationsfeld Einträge aus einer weiteren Tabelle anzeigen.

Das erste Kombinationsfeld wird bereits aus einer anderen Tabelle gefüllt.

Ich versuche also jetzt per VBA irgendwie einen Bezug von der Auswahl zur Tabelle zu erzeugen und komme nicht weiter.

Das sieht nun so aus (Variablen, weil ich nicht weiß wie ich die Spalten der Tabelle anhand der Auswahl im Kombinationsfeld auswählen soll):

Private Sub KombiFeld01_AfterUpdate()

  Dim strSQL As String, Auswahl As String, Spalte As String, cbo As ComboBox, cbo2 As ComboBox

   

  Set cbo = Me!KombiFeld01

  Set cbo2 = Me!KombiFeld02

   

  Select Case True

  Case cbo = "Artikelbezeichnung"

  Spalte = "Artikelbezeichnung"

  Case cbo = "Artikel-Nummer"

  Spalte = "ArtikelNummer"

  Case cbo = "FA-Nummer"

  Spalte = "FANummer"

  Case cbo = "Fehlermeldung Nr."

  Spalte = "Nr"

  Case cbo = "Kunde"

  Spalte = "KundeLang"

  Case cbo = "Status"

  Spalte = Me!KombiFeld01

  Case cbo = "Zuständig"

  Spalte = "zuständig"

  End Select

   

  strSQL = "SELECT DISTINCT '" & Spalte & "' FROM Fehlermeldungen ORDER BY '" & Spalte & "' WHERE '" & cbo & "' "

  cbo2.RowSource = strSQL

End Sub

Ich verstehe nicht, wie Select where überhaupt funktioniert.

Vielleicht kann jemand helfen. Vielen Dank.

Access, VBA
In Excel Makros aus aktiven Sheet löschen?

Ich Möchte ein Tabellenblatt neben das Original kopieren, in dem man nichts mehr ändern kann, aber anschliesssend die Sub Makros aus der Kopie Löschen, da sonnst die Datie zu groß wird. Das Kopieren funktioniert super, nur mit den Makros entfernen noch nicht so.

Das ist mein Code zum Kopieren, Danke

Sub NeuesTabBlatt()
' Monate Soll
 If MsgBox("Wollen Sie wirklich einen neuen Sollplan erstellen?", vbYesNo) = vbYes Then
 If InputBox("geben sie Bitte das Passwort zum Entsperren ein", "  Sollplanerstellung") = "1234" Then
        MsgBox "OK, der Sollplan wird erstellt"
 Else
 MsgBox "Hier kommst Du net rein!"
 ActiveSheet.Range("$A$1").Select
 Exit Sub
 End If
Application.ScreenUpdating = False
Application.Calculation = False
Dim NewName As String
ActiveWorkbook.Unprotect Password:="1234"
NewName = ActiveSheet.Range("$CW$1")
ActiveSheet.Copy After:=ActiveSheet
 ActiveSheet.Name = "Soll" & " " & ActiveSheet.Range("CW1")
  ActiveSheet.Range("AT127:AV134,AQ133:AS133, AT183:AV186, AT228:AV232").Clear
       ZeilenEinUndAusblenden
    ActiveSheet.EnableSelection = xlNoSelection
   ActiveSheet.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True
   ActiveSheet.Visible = False
  ActiveWorkbook.Protect "1234", Structure:=True
  Application.Calculation = xlAutomatic
 Application.ScreenUpdating = True
 MsgBox "ein neues SOLL Tabellenblatt wurde erstellt"
 End If
 'BlätterSollEinAus
 ActiveSheet.Range("$A$1").Select
End Sub 
Microsoft Excel, VBA
Excel VBA: Tabellenblätter bei gewissen Zellenwert ausblenden?

Hallo Zusammen,

Ich will mittels VBA ein Excel modifizieren, damit möglichst wenige Tabellenblätter angezeigt werden. In einem Tabellenblatt (z.B. "Auswahl") habe ich die Zellen C62, C88 und C114, die jeweils ein spezielles Tabellenblatt anzeigen sollen. Jedoch gibt es im Moment nur LZF-Meldungen.

Es soll jeweils bei "Yes" nichts angezeigt, bei "No" die entsprechende Tabelle eingeblendet werden.

Ansonsten sollen die "nicht betroffenen" Tabellen ausgeblendet bleiben

Hier der Code im Worksheet "DieseArbeitsmappe":

Private Sub Worksheet_Open()

'Beim Öffnen des Excels die betroffenen Blätter ausblenden
    ThisWorkbook.Worksheets("Tabelle4").Visible = False 
    ThisWorkbook.Worksheets("Tabelle5").Visible = False
    ThisWorkbook.Worksheets("Tabelle6").Visible = False
    
End Sub

In Blatt "Auswahl" (Tabelle7) habe ich folgenden Code:

Private Sub Worksheet_Change(ByVal Target As Range)

   

‘Hier sind vorher noch andere IF-Regeln hinterlegt, die nur Reihen in Tabelle7 ein/ausblenden

   

    If Range("C62").Value = "No" Then 'Tabellenblätter einblenden, sobald in der jeweiligen Zelle "No" ausgewählt wird

        ThisWorkbook.Worksheets("Tabelle6").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle6").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

    If Range("C88").Value = "No" Then

        ThisWorkbook.Worksheets("Tabelle5").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle5").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

    If Range("C114").Value = "No" Then

        ThisWorkbook.Worksheets("Tabelle4").Visible = True

       

        Else

        ThisWorkbook.Worksheets("Tabelle4").Visible = False ‘Hier erhalte ich jeweils ein LZF 9?

    End If

   

End Sub

Weshalb gibt es jeweils einen Fehler und wie kann ich diesen am einfachsten beheben?

Vielen Dank, Michael

Microsoft Excel, programmieren, Makro, VBA
Maximale Pfadlänge in Windows und VBA umgehen?

Hallo,

ich benutze folgenden Code in Excel VBA um mir Dateipfad und Dateiname eines Ordners und allen darin enthaltenen Unterordnern aufzulisten.
(Ihr könnt es testen, den Code einfach in ein Modul kopieren, "MainList" ausführen und einen Ordner eurer Wahl auswählen)

Ich habe jetzt das Problem, dass dieser Code alle Dateien überspringt, deren Pfadlänge über 255 Zeichen lang ist. Einige Dateien überschreiten nämlich die 255 Zeichen mit dem angehängten Dateinamen.
Sie liegen aber dennoch ab. Nur liest VBA diese nicht aus. Kann man da was dran machen?

Sub MainList()
'Updateby Extendoffice
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
  Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub

Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function
Computer, Windows, Microsoft, Datei, Microsoft Excel, programmieren, VBA
VBA : wie erstelle ich Kombinationen mit einem if?

Moin!

Ich tue mich extrem schwer mit dem lernen, aber ich versuchs weiter.

Ich habe nun versucht etwas zu erstellen, das in excel wie die "wenn" funktion, funktioniert, aber ich bekomme es nicht hin.

Ich habe eine Lösung gefunden, wie ich kombinationen erstelle und möchte diese nun verfeinern.

Mir geht es darum das B und C kombiniert werden, aber nichts doppelt ist( aber nur wenn es spalten übergreifen ist!)

Wenn da jemand helfen kann und lust, auf eine umfangreiche erklärung hat, dann freut mich das, ansonsten versuche ich mir die erklärung selber bei zu bringen. :)

Sub Alle()                                             'Name


Dim xDRg1, xDRg2 As Range                                   'Namen der Tabelle als "fortlaufenden bereich"
Dim xRg  As Range                                           '
Dim xStr As String                                          ' String für das leerzeichen
Dim xFN1, xFN2 As Integer                        
Dim xSV1, xSV2 As String

Set xDRg1 = Range("B2:B11")                                 'Tabelle 1
Set xDRg2 = Range("C2:C11")                                 'Tabelle 2


xStr = " "                                                  'Trennzeichen

Set xRg = Range("L5")                                       'Zelle für die Ausgabe


' wenn zeichen 1&2 aus der ersten Zelle in "B"  "nicht gleich" Zeichen 1&2 oder 4&5( wegen dem leerzeichen)aus der ersten Zelle aus "C",
' oder wenn zeichen 4&5 aus der ersten Zelle in "B"  "nicht gleich" Zeichen 1&2 oder 4&5( wegen dem leerzeichen)aus der ersten Zelle aus "C" sind,
' dann soll: ( ansonsten überspringen)

For xFN1 = 1 To xDRg1.Count
    xSV1 = xDRg1.Item(xFN1).Text
    
For xFN2 = 1 To xDRg2.Count
    xSV2 = xDRg2.Item(xFN2).Text
      

    
    
    xRg.Value = xSV1 & xStr & xSV2
        Set xRg = xRg.Offset(1, 0)                'Schreiben in die Zelle

       Next                                            'Ende der For Schleife
Next                                                 'Ende der For Schleife

End Sub


Bild zum Beitrag
Computer, Microsoft Excel, VBA, Informatik
Kann man den Benutzernamen in einem UserForm Label angeben, der das Dokument geöffnet hat?

Hi, ich liebe Herausforderungen und komme auch nach und nach weiter. Nun habe ich diese Funktion welche prüft, ob eine bestimmte Datei geöffnet ist:

Public Function IsFileOpen(FileName As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next
    filenum = FreeFile()
    Open FileName For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0
    Select Case errnum
    Case 0
    IsFileOpen = False
    Case 70
    IsFileOpen = True
    Case Else
    Error errnum
    End Select
End Function

Mit dieser Funktion kann ich arbeiten, wenn das Dokument von wem auch immer geöffnet ist, öffnet sich eine UserForm.

Nun möchte ich gerne mit dieser Funktion ermitteln, welcher Benutzer das Dokument geöffnet hat:

Public Function LastUser(strPath As String) As String
    Dim strXl As String
    Dim strFlag1 As String, strflag2 As String
    Dim i As Integer, j As Integer
    Dim hdlFile As Long
    Dim lNameLen As Byte
   
    strFlag1 = Chr(0) & Chr(0)
    strflag2 = Chr(32) & Chr(32)
   
    hdlFile = FreeFile
    Open strPath For Binary As #hdlFile
        strXl = Space(LOF(hdlFile))
        Get 1, , strXl
    Close #hdlFile
   
    j = InStr(1, strXl, strflag2)
   
    #If Not VBA6 Then
        '// Xl97
        For i = j - 1 To 1 Step -1
            If Mid(strXl, i, 1) = Chr(0) Then Exit For
        Next
        i = i + 1
    #Else
        '// Xl2000+
        i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
    #End If
   
    '// IFM
    lNameLen = Asc(Mid(strXl, i - 3, 1))
    LastUser = Mid(strXl, i, lNameLen)
End Function

Aber das klappt nicht...

Ich habe es mit diesem Code probiert und diesen an meinen Pfad und das Dokument angepasst:

Private Sub TestVBA()
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'// Just change the file to test here
Const strFileToOpen As String = "C:\Data.xls"
If IsFileOpen(strFileToOpen) Then
MsgBox strFileToOpen & " is already Open" & _
vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
Else
MsgBox strFileToOpen & " is not open", vbInformation
End If
End Sub

Bekomme immer Fehler 52.

Ich würde aber gerne den Benutzernamen auch später in der UserForm (anstatt einer MsgBox) im Label anzeigen, was ich ebenfalls nicht hinbekomme.

Weiß jemand, wie ich den Benutzernamen ermittel, der das Dokument geöffnet hat und ich diesen dann in den Label-Text einbauen kann? Oder geht das nicht?

Vielen herzlichen Dank im Voraus.

Microsoft Excel, VBA, VBA Excel
Kann Excel das ohne VBA?

Guten Tag liebes Forum,

Vorab sei gesagt, dass ich aufgrund von dienstlichen Vorgaben keine Screenshots meiner Arbeitsmappe anhängen kann. Ich hoffe, dass der Ein oder Andere mir dennoch helfen kann.

Folgender Sachverhalt:
Meine Excel-Arbeitsmappe enthält zwei Arbeitsblätter:
- "Bezüge" (dieses wird als Datenbank genutzt, um das Hauptblatt sauber zu halten)
- "Anwesenheit"

Im Blatt "Bezüge" sind in den Zellen F2:DW2 Wochentage (abgekürzt) aufgelistet. In den Zellen F3:DW3 das dazugehörige Datum.

Samstage sowie Sonntage sind durch bedingte Formatierung "grau" hinterlegt.

Im Blatt "Anwesenheit" stehen ganz viele Namen untereinander und oben drüber von links nach recht die Wochentage sowie in einer Zelle darunter das jeweilige Datum. Quasi identisch mit "Bezüge"

Auch hier ist das Färben der Samstage sowie Sonntage keine große Problematik, wenn bedingte Formatierung genutzt wird. Allerdings steh ich ein wenig auf dem Schlauch, wenn es darum geht das zugehörige Datum zum Wochentag in identischer Farbe (wie die bedingte Formatierung den Wochentag) darzustellen.

Zusätzlich sei gesagt, dass alle Wochentage und Datum-Angaben im Blatt "Anwesenheit" mit "=WENN" bzw. "=WENN(UND"- Formeln erzeugt werden und sich entsprechend auf "Bezüge" beziehen.

Gibt es hierfür eine eigene Formel oder eine Möglichkeit vorhandene Formeln in der Zielzelle zu ergänzen?

Grundsätzlich wäre auch eine VBA-Lösung annehmbar. ich bin zwar Neueinsteiger aber mit 30/40 Zeilen VBA sollte ich irgendwie zurecht kommen.

Ganz ganz lieben Dank und beste Grüße.

Microsoft Excel, VBA
Kann ich RGB Farben statt Indexfarben nutzen?

Ich habe eine Exceltabelle in der ich durch Zahleneingabe, bestimmte Zellen in den Indexfarben einfärben kann. Ich gebe eine Zahl ein und die Zelle und alle damit verbunden Zellen oder Zellen, welche die gleiche Funktion vorweisen müssen färben sich.

Nun gibt es nur 56 Indexfarben, welche zudem auch noch ziemlich grelle Farben sind. Ich hätte gerne ein größeres Spektrum an Farben, welches ich durch die RGB Farben bekommen kann. Nur weis ich nicht wie ich dies jetzt in meine Funktion einsetzen soll.

Ich habe nur ein Feld um eine Zahl reinzuschreiben und nicht 3, also ein Feld für R, eins für G und eins für B ist nicht umsetzbar.

Anbei meine VBA Programmierung:

Sub Farbe_Topic()
' Farbe_Topic Makro: Hier wird jetzt das "Status-Feld" in der gleichen Farbe formatiert, wie die, die auch in den ARbeitsblättern gewünscht ist
' Tastenkombination: Strg+w
  Range("B2:C2").Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = Tabelle11.Cells(2, 3) ' In dieser Zelle steht zum Beispiel eine 3 --> somit Farbe rot
    .TintAndShade = 0
    .PatternTintAndShade = 0
  Selection.Font.ColorIndex = Tabelle11.Cells(2, 11)
  End With
  Range("B3:C3").Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = Tabelle11.Cells(3, 3)
    .TintAndShade = 0
    .PatternTintAndShade = 0
  Selection.Font.ColorIndex = Tabelle11.Cells(3, 11)
  End With
 
  Range("B4:C4").Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = Tabelle11.Cells(4, 3)
    .TintAndShade = 0
    .PatternTintAndShade = 0
  Selection.Font.ColorIndex = Tabelle11.Cells(4, 11)
  End With
  Range("B5:C5").Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = Tabelle11.Cells(5, 3)
    .TintAndShade = 0
    .PatternTintAndShade = 0
  Selection.Font.ColorIndex = Tabelle11.Cells(5, 11)
  End With
  Range("B6:C6").Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = Tabelle11.Cells(6, 3)
    .TintAndShade = 0
    .PatternTintAndShade = 0
  Selection.Font.ColorIndex = Tabelle11.Cells(6, 11)
  End With
  Range("B7:C7").Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = Tabelle11.Cells(7, 3)
    .TintAndShade = 0
    .PatternTintAndShade = 0
  Selection.Font.ColorIndex = Tabelle11.Cells(7, 11)
  End With
  Range("B8:C8").Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = Tabelle11.Cells(8, 3)
    .TintAndShade = 0
    .PatternTintAndShade = 0
  Selection.Font.ColorIndex = Tabelle11.Cells(8, 11)
  End With

Vielleicht hilft dieses Bild noch dabei:

Bild zum Beitrag
Microsoft Excel, VBA
VBA Dateiauswahl - Bei Abbruch Laufzeitfehler 5, jemand Ideen?

Hallo zusammen,

was müsste ich hinzufügen, um den Laufzeitfehler 5 zu umgehen? Wenn ich den VBA-Code ausführe, öffnet sich das Fenster für den Import von DAT-Dateien. Drücke ich auf Abbrechen, erscheint der Laufzeitfehler 5. Vermerkt wird der Code "Set F = fs.GetFolder(strPfad)". Wo und welchen Code müsste ich hinzufügen, um den Fehler zu beheben? Vielen Dank im Voraus. :)

Sub Schaltfläche1_Klicken()
'
'
'*** Öffnen von DAT-Dateien
Dim strText As String, strFilter As String

strText = "Bitte eine Auswertung Auswählen"
strFilter = "DAT-Dateien (*.DAT), *.DAT"""
strAuswahl = Application.GetOpenFilename(strFilter, 1, strText)
strPfad = Pfad_ermitteln(strAuswahl)
'
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder(strPfad)
Set fc = F.Files

If ActiveSheet Is Nothing Then Workbooks.Add
For Each File In fc
    Zeile = Cells(65000, 1).End(xlUp).Row + 2
    strEinfügen = Cells(Zeile, 1).Address
    strAuswahl = File.Path

    'Einfügen
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strAuswahl _
        , Destination:=Range(strEinfügen))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
  End With
  Range(strEinfügen).QueryTable.Delete
Next
End Sub
_______________________________

 Function Pfad_ermitteln(ByVal strAuswahl As String) As String
 
 For i = Len(strAuswahl) To 1 Step -1
    If Mid(strAuswahl, i, 1) = "\" Then
        Pfad_ermitteln = Left(strAuswahl, i - 1)
        Exit Function
    End If
Next
End Function
Computer, Microsoft Excel, Microsoft Office, Makro, VBA, Code

Meistgelesene Beiträge zum Thema VBA