|
Hallo,
ich möchte ein Makro dahingehend erweitern, das ich statt nur einem Arbeitsblatt (hier "2") mehrere Arbeitsblätter habe (hier "1" und "3" zusätzlich).
Option Explicit
Const SCORE_1_START = 36
Const SCORE_2_START = 61
Const SCORE_3_START = 86
Const SCORE_4_START = 111
Const SCORE_5_START = 136
Const SCORE_6_START = 161
Const SCORE_7_START = 186
Const SCORE_8_START = 211
Const SCORE_9_START = 236
Const SCORE_10_START = 261
Const SCORE_11_START = 286
Const SCORE_12_START = 311
Const SCORE_13_START = 336
Const SCORE_14_START = 361
Const SCORE_15_START = 386
Const SCORE_16_START = 411
Const SCORE_17_START = 436
Const SCORE_18_START = 461
Const SCORE_19_START = 486
Const SCORE_20_START = 511
Const SCORE_21_START = 536
Const SCORE_1_END = 59
Const SCORE_2_END = 84
Const SCORE_3_END = 109
Const SCORE_4_END = 134
Const SCORE_5_END = 159
Const SCORE_6_END = 184
Const SCORE_7_END = 209
Const SCORE_8_END = 234
Const SCORE_9_END = 259
Const SCORE_10_END = 284
Const SCORE_11_END = 309
Const SCORE_12_END = 334
Const SCORE_13_END = 359
Const SCORE_14_END = 384
Const SCORE_15_END = 409
Const SCORE_16_END = 434
Const SCORE_17_END = 459
Const SCORE_18_END = 484
Const SCORE_19_END = 509
Const SCORE_20_END = 534
Const SCORE_21_END = 559
Const SCORE_2_SCORE = 63
Const SCORE_3_SCORE = 88
Const SCORE_4_SCORE = 113
Const SCORE_5_SCORE = 138
Const SCORE_6_SCORE = 163
Const SCORE_7_SCORE = 188
Const SCORE_8_SCORE = 213
Const SCORE_9_SCORE = 238
Const SCORE_10_SCORE = 263
Const SCORE_11_SCORE = 288
Const SCORE_12_SCORE = 313
Const SCORE_13_SCORE = 338
Const SCORE_14_SCORE = 363
Const SCORE_15_SCORE = 388
Const SCORE_16_SCORE = 413
Const SCORE_17_SCORE = 438
Const SCORE_18_SCORE = 463
Const SCORE_19_SCORE = 488
Const SCORE_20_SCORE = 513
Const SCORE_21_SCORE = 538
Public Sub read()
Dim filename As String
Dim NewBook As Workbook
filename = ThisWorkbook.path & "\n01_data.csv"
If Dir(filename) = "" Then
MsgBox "CSV file was not found.", vbExclamation
Exit Sub
End If
'' _______íÄRÄs[[
Set NewBook = Workbooks.Add
ThisWorkbook.Sheets(Array("2", "CSV")).Copy Before:=NewBook.Sheets(1)
Application.DisplayAlerts = False
Do While NewBook.Sheets.Count > 2
NewBook.Sheets(3).Delete
Loop
Application.DisplayAlerts = True
''____ÄA
NewBook.Sheets("CSV").UsedRange.Clear
''CSV_____â_Ý
Call read_csv(filename, NewBook.Sheets("CSV"))
NewBook.Sheets("2").Select
NewBook.Activate
Call Kill(filename)
ThisWorkbook.Saved = True
ThisWorkbook.Close
End Sub
Private Sub read_csv(filename As String, xlSt As Worksheet)
Dim str As String
Dim x() As String
Dim f As Integer
Dim i As Long
Dim j As Integer
Dim s As Integer
Dim t As Integer
''_________íÒ‚â__â_Ý
f = FreeFile
Open filename For Input As #f
i = 1
Do Until EOF(f)
Line Input #f, str
If i = 1 Then
ReDim x(4)
s = 1
For j = 0 To 4
If Mid(str, s, 1) <> """" Then
t = InStr(s, str, ",")
If t = 0 Then
''______¥¦__Ñ–
x(j) = Mid(str, s)
s = 0
Else
''_____–Õ_oo
x(j) = Mid(str, s, t - s)
s = t + 1
End If
Else
'' "_" ___Î`_¨
s = s + 1
t = InStr(s, str, """")
Do While t <> 0
If Mid(str, t + 1, 1) <> """" Then
Exit Do
End If
t = InStr(t + 2, str, """")
Loop
If t = 0 Then
t = InStr(s, str, ",")
End If
If t = 0 Then
''______¥¦__Ñ–
x(j) = Mid(str, s)
s = 0
Else
''_____–Õ_oo
x(j) = Mid(str, s, t - s)
x(j) = Replace(x(j), """""", """")
''________öæÕu_¾Ò_
s = InStr(t + 1, str, ",")
If s <> 0 Then
s = s + 1
End If
End If
End If
If s = 0 Then
Exit For
End If
Next j
Else
x = Split(str, ",")
End If
If UBound(x) > 1 Then
''_________æÕuâ__Õè
Select Case x(0)
Case "Round"
If i < SCORE_1_START Then
i = SCORE_1_START
ElseIf i > SCORE_1_START And i < SCORE_2_START Then
i = SCORE_2_START
ElseIf i > SCORE_2_START And i < SCORE_3_START Then
i = SCORE_3_START
ElseIf i > SCORE_3_START And i < SCORE_4_START Then
i = SCORE_4_START
ElseIf i > SCORE_4_START And i < SCORE_5_START Then
i = SCORE_5_START
ElseIf i > SCORE_5_START And i < SCORE_6_START Then
i = SCORE_6_START
ElseIf i > SCORE_6_START And i < SCORE_7_START Then
i = SCORE_7_START
ElseIf i > SCORE_7_START And i < SCORE_8_START Then
i = SCORE_8_START
ElseIf i > SCORE_8_START And i < SCORE_9_START Then
i = SCORE_9_START
ElseIf i > SCORE_9_START And i < SCORE_10_START Then
i = SCORE_10_START
ElseIf i > SCORE_10_START And i < SCORE_11_START Then
i = SCORE_11_START
ElseIf i > SCORE_11_START And i < SCORE_12_START Then
i = SCORE_12_START
ElseIf i > SCORE_12_START And i < SCORE_13_START Then
i = SCORE_13_START
ElseIf i > SCORE_13_START And i < SCORE_14_START Then
i = SCORE_14_START
ElseIf i > SCORE_14_START And i < SCORE_15_START Then
i = SCORE_15_START
ElseIf i > SCORE_15_START And i < SCORE_16_START Then
i = SCORE_16_START
ElseIf i > SCORE_16_START And i < SCORE_17_START Then
i = SCORE_17_START
ElseIf i > SCORE_17_START And i < SCORE_18_START Then
i = SCORE_18_START
ElseIf i > SCORE_18_START And i < SCORE_19_START Then
i = SCORE_19_START
ElseIf i > SCORE_19_START And i < SCORE_20_START Then
i = SCORE_20_START
ElseIf i > SCORE_20_START And i < SCORE_21_START Then
i = SCORE_21_START
End If
Case "Darts"
If i > SCORE_1_START + 1 And i < SCORE_1_END Then
i = SCORE_1_END
ElseIf i > SCORE_1_END And i < SCORE_2_END Then
i = SCORE_2_END
ElseIf i > SCORE_2_END And i < SCORE_3_END Then
i = SCORE_3_END
ElseIf i > SCORE_3_END And i < SCORE_4_END Then
i = SCORE_4_END
ElseIf i > SCORE_4_END And i < SCORE_5_END Then
i = SCORE_5_END
ElseIf i > SCORE_5_END And i < SCORE_6_END Then
i = SCORE_6_END
ElseIf i > SCORE_6_END And i < SCORE_7_END Then
i = SCORE_7_END
ElseIf i > SCORE_7_END And i < SCORE_8_END Then
i = SCORE_8_END
ElseIf i > SCORE_8_END And i < SCORE_9_END Then
i = SCORE_9_END
ElseIf i > SCORE_9_END And i < SCORE_10_END Then
i = SCORE_10_END
ElseIf i > SCORE_10_END And i < SCORE_11_END Then
i = SCORE_11_END
ElseIf i > SCORE_11_END And i < SCORE_12_END Then
i = SCORE_12_END
ElseIf i > SCORE_12_END And i < SCORE_13_END Then
i = SCORE_13_END
ElseIf i > SCORE_13_END And i < SCORE_14_END Then
i = SCORE_14_END
ElseIf i > SCORE_14_END And i < SCORE_15_END Then
i = SCORE_15_END
ElseIf i > SCORE_15_END And i < SCORE_16_END Then
i = SCORE_16_END
ElseIf i > SCORE_16_END And i < SCORE_17_END Then
i = SCORE_17_END
ElseIf i > SCORE_17_END And i < SCORE_18_END Then
i = SCORE_18_END
ElseIf i > SCORE_18_END And i < SCORE_19_END Then
i = SCORE_19_END
ElseIf i > SCORE_19_END And i < SCORE_20_END Then
i = SCORE_20_END
ElseIf i > SCORE_20_END And i < SCORE_21_END Then
i = SCORE_21_END
End If
End Select
''____¥ïâµ
If i = SCORE_1_END And x(0) <> "Darts" Then
i = SCORE_2_SCORE
ElseIf i = SCORE_2_END And x(0) <> "Darts" Then
i = SCORE_3_SCORE
ElseIf i = SCORE_3_END And x(0) <> "Darts" Then
i = SCORE_4_SCORE
ElseIf i = SCORE_4_END And x(0) <> "Darts" Then
i = SCORE_5_SCORE
ElseIf i = SCORE_5_END And x(0) <> "Darts" Then
i = SCORE_6_SCORE
ElseIf i = SCORE_6_END And x(0) <> "Darts" Then
i = SCORE_7_SCORE
ElseIf i = SCORE_7_END And x(0) <> "Darts" Then
i = SCORE_8_SCORE
ElseIf i = SCORE_8_END And x(0) <> "Darts" Then
i = SCORE_9_SCORE
ElseIf i = SCORE_9_END And x(0) <> "Darts" Then
i = SCORE_10_SCORE
ElseIf i = SCORE_10_END And x(0) <> "Darts" Then
i = SCORE_11_SCORE
ElseIf i = SCORE_11_END And x(0) <> "Darts" Then
i = SCORE_12_SCORE
ElseIf i = SCORE_12_END And x(0) <> "Darts" Then
i = SCORE_13_SCORE
ElseIf i = SCORE_13_END And x(0) <> "Darts" Then
i = SCORE_14_SCORE
ElseIf i = SCORE_14_END And x(0) <> "Darts" Then
i = SCORE_15_SCORE
ElseIf i = SCORE_15_END And x(0) <> "Darts" Then
i = SCORE_16_SCORE
ElseIf i = SCORE_16_END And x(0) <> "Darts" Then
i = SCORE_17_SCORE
ElseIf i = SCORE_17_END And x(0) <> "Darts" Then
i = SCORE_18_SCORE
ElseIf i = SCORE_18_END And x(0) <> "Darts" Then
i = SCORE_19_SCORE
ElseIf i = SCORE_19_END And x(0) <> "Darts" Then
i = SCORE_20_SCORE
ElseIf i = SCORE_20_END And x(0) <> "Darts" Then
i = SCORE_21_SCORE
End If
End If
''_________\â¥tâøâŽ
For j = 0 To 4
If UBound(x) < j Then
Exit For
End If
xlSt.Range(xlSt.Cells(i, j + 1), xlSt.Cells(i, j + 1)).Value = x(j)
Next j
i = i + 1
Loop
Close #f
End Sub
Kann mir jemand helfen, wie ich das Makro erweitern muß?
Vielen Dank
Jens
|