Tino Sperlich

Kategorien
Buch
Film
Foto
Gesellschaft
HH TTT
Links
Musik
Reise
Schon-immer-mal
Software + Java

Excel-Programmierung 2

Der Ärger mit mündlichen Spezifikationen ist, das sie zwar immer frisch sind, aber leider auch seeehr mißverständlich.

Ich: "Fertig, keine Dupletten gefunden!"
MB: "Wie, ich hab doch noch keine Mediennummer eingegeben? Ähh!?"
Ich: "Wieso, stehen die nicht gerade doppelt in den Dateien?"
MB: "Nein, da sind keine doppelt. Ich will nur nach einer Nummer suchen, die ich eingebe." - Arrgh )

Gut, dann eben nocheinmal, und so: (endlich kann ich mal den Syntaxhighligter einbauen :-))

<< <

Public fso As New FileSystemObject

Sub Einlesen()
	Dim mediennummer As String
	Dim kundendateien As Collection
	Dim Worksheet As Worksheet
	'Simplest handler - continue on error
	On Error Resume Next

	Dim Path, mediennummerSearch, msgText As String
	Dim result As Collection
	Dim baseFolder As folder

	mediennummerSearch = InputBox("Bitte gesuchte Mediennummer eingeben: ")
	If mediennummerSearch = "" Then Exit Sub

	Dim RefreshYesNo
	If Not map Is Nothing Then
	RefreshYesNo = MsgBox("Haben Sie neue Verbuchungen vorgenommen oder hat sich das Verzeichnis geändert?: ", vbYesNo)
	If RefreshYesNo = vbNo Then GoTo search
	End If

	Set map = New Dictionary
	ReadInWorkBooks

	search:
	If map.Exists(mediennummerSearch) Then
  	msgText = "Mediennummer '" & mediennummerSearch & "' vorhanden in: " & ToString(map.Item(mediennummerSearch))
	Else
		msgText = "Mediennummer '" & mediennummerSearch & "' nicht gefunden!"
	End If

	Response = MsgBox(msgText, vbOKOnly)

End Sub

Sub ReadInWorkBooks()
	Application.DisplayStatusBar = True

	Path = Application.GetOpenFilename("Excel-Dateien,*.xls")
	Path = Left(Path, InStrRev(Path, "\"))
	Set baseFolder = fso.GetFolder(Path)
	Dim workBookCount, totalCount As Integer
	totalCount = baseFolder.Files.Count

	For Each wbkName In baseFolder.Files
		'exclude macro file, result file and non-excel files
		If wbkName.Name = "Ergebnis.xls" Then GoTo continue
		If wbkName.Name = ThisWorkbook.Name Then GoTo continue
		If UCase(Right(wbkName.Name, 4)) <> ".XLS" Then GoTo continue
		workBookCount = workBookCount + 1

		Application.StatusBar = "Verarbeite " & workBookCount & "/" & totalCount

		Workbooks.Open wbkName.Path

		For Each Worksheet In Workbooks(wbkName.Name).Worksheets
	   Dim intCounter As Integer
  	 For i = 1 To Worksheet.UsedRange.Rows.Count
		  	For j = 1 To Worksheet.UsedRange.Columns.Count
					If IsRelevant(Cells(i, j)) Then
						mediennummer = Cells(i, j).Value
						Kundendatei = wbkName.Name
						If map.Exists(mediennummer) Then
							Set kundendateien = map(mediennummer)
							kundendateien.Add Kundendatei
						Else
							Set kundendateien = New Collection
							kundendateien.Add Kundendatei
							map.Add mediennummer, kundendateien
						End If
			 		End If
				Next j
			Next i
		Next

	Workbooks(wbkName.Name).Close

	continue:
	Next

 Application.StatusBar = False

End Sub