Author: michael

Option Explicit
Option Compare Text
Const sRootPath As String = "C:\Temp"
Private lRowCounter As Long
Private oSheet As Object
Public Sub DateienMitUnterordnernAuslesen()
         Set oSheet = Sheets.Add
         oSheet.Activate
         oSheet.Cells(1, 1).Select
         Call CreateHeadLinesAndFormat
         lRowCounter = 2
         Call ReadSubFolder(sRootPath)
         Set oSheet = Nothing
End Sub
Private Sub CreateHeadLinesAndFormat()
   Dim i As Long
     oSheet.Cells(1, 1) = "Spalte1"
     oSheet.Cells(1, 2) = "Spalte2"
     oSheet.Columns(1).ColumnWidth = 40
     oSheet.Columns(2).ColumnWidth = 40
     For i = 1 To 2
         With oSheet
             .Cells(1, i).Interior.ColorIndex = 11
             .Cells(1, i).Font.Color = vbWhite
             .Cells(1, i).Font.Bold = True
         End With
     Next i
End Sub
Private Sub ReadSubFolder(ByVal sPath As String)
   Dim oFSO As Object
   Dim oFolder As Object
   Dim oSubFolder As Object
   Dim oFile As Object
     Set oFSO = CreateObject("Scripting.FileSystemObject")
     Set oFolder = oFSO.getfolder(sPath)
     With oSheet
         For Each oSubFolder In oFolder.subfolders
             For Each oFile In oSubFolder.Files
                 .Cells(lRowCounter, 1) = oSubFolder.Path
                 .Cells(lRowCounter, 2) = oFile.Name
                 lRowCounter = lRowCounter + 1
             Next oFile
            Call ReadSubFolder(oSubFolder.Path)
         Next oSubFolder
     End With
     Set oFSO = Nothing
     Set oFile = Nothing
     Set oFolder = Nothing
     Set oSubFolder = Nothing
End Sub

Ausgabe in G1

Sub BereichVerketten()
Dim c As Range, tmp As String
For Each c In Selection
  tmp = tmp & c & "', '"
Next
tmp = Left(tmp, Len(tmp) - 1)
[g1] = tmp
End Sub

Bezogen auf einen bestimmten Bereich im VBA-Projekt:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D3:D5,E3:E5")) Is Nothing Then
If Target.Value > 0 Then
If Target.Value < 0.82 Then
MsgBox "Bitte........"
End If
End If
End If
End Sub

Function HFanzahl(Farbe, Bereich)
Anzahl = 0
For Each Zelle In Bereich
If Zelle.Interior.ColorIndex = Farbe Then
Anzahl = Anzahl + 1
End If
Next
HFanzahl = Anzahl
End Function
Function HFwert(r As Range) As Integer
HFwert = r.Interior.ColorIndex
End Function

Ermittlung zu zählende Hintergrundfarbe Formel in Zelle W3:

=HFwert(W3)

Hintergrundfarbe aus Zelle W3 in bestimmtem Bereich zählen:

=HFanzahl(W3;$A$1:$U$98)