array

Liebe Mitglieder, konzentriert euch einfach mal auf den Array. Wenn der code durchläuft und die Datei nicht 12 Blätter hat, sondern beispielsweise nur 10 (beginnend mit März, April..)kommt am Ende heraus:
Blatt März wurde zu Jan_2018_Name etc.
ich bin mir sicher es liegt am Array aber ich kenne mich zu wenig aus. Ich müsse 100 Dateien bearbeiten, aber nicht alle haben eben 12 Blätter. Könnt ihr mir einen Tipp geben, das wäre super. DANKE

Sub NEU()
Dim WbNeuFallzahl As Workbook
Dim ws As Worksheet
Dim BPx As String
Dim BPxLang As String
Dim strFileName As String
Dim strFilter As String
Dim strInitFileName As String
Dim i As Long
Dim wsNumber As Long
Dim arrMonat(1 To 12) As Variant
arrMonat(1) = "Jan"
arrMonat(2) = "Feb"
arrMonat(3) = "März"
arrMonat(4) = "April"
arrMonat(5) = "Mai"
arrMonat(6) = "Juni"
arrMonat(7) = "Juli"
arrMonat(8) = "Aug"
arrMonat(9) = "Sept"
arrMonat(10) = "Okt"
arrMonat(11) = "Nov"
arrMonat(12) = "Dez"
Dim arrMonatlang(1 To 12) As Variant
arrMonatlang(1) = "Januar"
arrMonatlang(2) = "Februar"
arrMonatlang(3) = "März"
arrMonatlang(4) = "April"
arrMonatlang(5) = "Mai"
arrMonatlang(6) = "Juni"
arrMonatlang(7) = "Juli"
arrMonatlang(8) = "August"
arrMonatlang(9) = "September"
arrMonatlang(10) = "Oktober"
arrMonatlang(11) = "November"
arrMonatlang(12) = "Dezember"
'DateiÖffnen Dialog
strFilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren
ChDrive "Q"
ChDir "Q:\Bereitschaftspraxen\Dienstprotokolle" '** Laufwerk und Pfad  _
definieren, welcher geöffnet werden soll
'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)
Set WbNeuFallzahl = Workbooks.Open(strFileName)
'** Hinweis ausgeben
MsgBox "Die Datei '" & WbNeuFallzahl.Name & "' wurde geöffnet.", vbInformation,  _
"Hinweis"
WbNeuFallzahl.Activate
Worksheets(1).Range("X1").Value = Worksheets(1).Range("B2") 'langen Namen behalten, damit ich  _
ihn später nicht wieder eingeben muss
BPxLang = Worksheets(1).Range("X1").Value
'Vorbereiten und BPx Namen kürzen, Monat kürzen
BPx = Application.InputBox("KurzName eingeben!") 'Kurznamen eingeben
For i = 1 To WbNeuFallzahl.Worksheets.Count
With WbNeuFallzahl.Worksheets(i)
.Cells(2, 2).Value = BPx 'kürzen
.Cells(4, 2).Value = arrMonat(i) ' Monat kürzen
End With
Next i
'Jeztt Blätter umbenennen
'WbNeuFallzahl.Activate
For Each ws In ActiveWorkbook.Worksheets
ws.Name = ws.Range("B4") & "_" & ws.Range("B3") & "_" & ws.Range("B2")
Next ws
'ursprügl. Namen & Monate wiederherstellen,
For i = 1 To WbNeuFallzahl.Worksheets.Count
With WbNeuFallzahl.Worksheets(i)
.Cells(2, 2).Value = BPxLang
.Cells(4, 2).Value = arrMonatlang(i)
End With
Next i
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Georg
Sie könnten das Problem wie nachfolgend mit einer IF-Funktion lösen, jedoch werde ich aus Ihrem Beispiel nicht ganz schlau. Sollte die Zelle X1 kein zentraler Bestandteil der Daten sein, können Sie diesen Monatsnahmen der Variable auch direkt zuordnen und müssen diese in keine separate Zelle schreiben (BPxLang = Worksheets(1).Range("B2")).
Wenn Sie die Monatsnamen kürzen möchten, dann müssen Sie zusätzlich auch das Array mit den kurzen Monatsnamen durchlaufen, weil Sie sonst immer denselben Monatsnamen hineinschreiben.
For i = 1 To WbNeuFallzahl.Worksheets.Count
if .cells(2,2).value = arrMonatlang(i) then
With WbNeuFallzahl.Worksheets(i)
.Cells(2, 2).Value = BPx 'kürzen
.Cells(4, 2).Value = arrMonat(i) ' Monat kürzen
End With
end if
Next i
For i = 1 To WbNeuFallzahl.Worksheets.Count
if .cells(4,2).value = arrMonat(i) then
With WbNeuFallzahl.Worksheets(i)
.Cells(2, 2).Value = BPxLang
.Cells(4, 2).Value = arrMonatlang(i)
End With
end if
Next i
Vielleicht hilft Ihnen diese Antwort trotzdem.
Gruß Sandra

Sub T_1() On Error Resume Next For i = 1 To 12 Debug.Print i, Application.GetCustomListContents(7)(i) Sheets(Application.GetCustomListContents(7)(i)).Activate If Err.Number 0 Then Sheets.Add(, ActiveSheet).Name = Application.GetCustomListContents(7)(i) Err.Clear End If Next i End Sub

Sub NEU() Dim WbNeuFallzahl As Workbook Dim BPx As String Dim strFilter As String Dim strFileName As String Dim i As Long Dim arrName, arrMonat(1 To 12), arrMonatLang(1 To 12) For i = 1 To 12 arrMonat(i) = MonthName(i, 1) arrMonatLang(i) = MonthName(i) Next i 'DateiÖffnen Dialog strFilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren ChDrive "Q" ChDir "Q:\Bereitschaftspraxen\Dienstprotokolle" '** Laufwerk und Pfad _ definieren, welcher geöffnet werden soll '** Den im Dialogfeld gewählten Namen auslesen strFileName = Application.GetOpenFilename(strFilter) Set WbNeuFallzahl = Workbooks.Open(strFileName) '** Hinweis ausgeben MsgBox "Die Datei '" & WbNeuFallzahl.Name & "' wurde geöffnet.", vbInformation, _ "Hinweis" WbNeuFallzahl.Activate 'Vorbereiten und BPx Namen kürzen, Monat kürzen BPx = Application.InputBox("KurzName eingeben!") 'Kurznamen eingeben For i = 1 To WbNeuFallzahl.Worksheets.Count With WbNeuFallzahl.Worksheets(i) arrName = Split(.Name, "_") arrName(0) = arrMonat(Application.Match(arrName(0), arrMonatLang, 0)) arrName(2) = BPx .Name = Join(arrName, "_") End With Next i End Sub

x = WbNeuFallzahlWorksheets.Count + 1 - WbNeuFallzahl.Worksheets.Count For i = 1 To WbNeuFallzahl.Worksheets.Count With WbNeuFallzahl.Worksheets(i) .Cells(2, 2).Value = BPx 'kürzen .Cells(4, 2).Value = arrMonat(x) ' Monat kürzen x = x + 1 End With Next i

Dim WbNeuFallzahl As Workbook Dim strFileName As String, strFilter As String, strInitFileName As String Dim i As Long, x As Long, daDatum As Date 'DateiÖffnen Dialog strFilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren ChDrive "Q" ChDir "Q:\Bereitschaftspraxen\Dienstprotokolle" '** Laufwerk und Pfad _ definieren, welcher geöffnet werden soll '** Den im Dialogfeld gewählten Namen auslesen strFileName = Application.GetOpenFilename(strFilter) Set WbNeuFallzahl = Workbooks.Open(strFileName) '** Hinweis ausgeben MsgBox "Die Datei '" & WbNeuFallzahl.Name & "' wurde geöffnet.", vbInformation, "Hinweis" x = 12 - WbNeuFallzahl.Worksheets.Count + 1 For i = 1 To WbNeuFallzahl.Worksheets.Count With WbNeuFallzahl.Worksheets(i) daDatum = DateSerial(2018, x, 1) .Name = Format(daDatum, "MMM") & "_" & .Range("B3") & "_" & .Range("B2") x = x + 1 End With Next i

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

array

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread