Mình gửi đoạn code nhé. Bạn trả lời nhanh quá, giật cả mình
Cám ơn
Function Count_Text(ByVal chuoi_can_tim As String, ByVal chuoi_nguon As String) As Integer
Dim i, j As Integer
j = 0
For i = 1 To Len(chuoi_nguon)
If (StrComp(Right(Left(chuoi_nguon, i), 1), chuoi_can_tim) = 0) Then
j = j + 1
End If
Next
Count_Text = j
End Function
Function Weekday_Style(ByVal ngay As String) As String
Select Case ngay
Case "Mo": Weekday_Style = "Mon"
Case "2": Weekday_Style = "Mon"
Case "Tu": Weekday_Style = "Tue"
Case "3": Weekday_Style = "Tue"
Case "We": Weekday_Style = "Wed"
Case "4": Weekday_Style = "Wed"
Case "Th": Weekday_Style = "Thu"
Case "5": Weekday_Style = "Thu"
Case "Fr": Weekday_Style = "Fri"
Case "6": Weekday_Style = "Fri"
Case "Sa": Weekday_Style = "Sat"
Case "7": Weekday_Style = "Sat"
Case "Su": Weekday_Style = "Sun"
Case "CN": Weekday_Style = "Sun"
Case "8": Weekday_Style = "Sun"
Case Else: Weekday_Style = ""
End Select
End Function
Function Weekday_Analysis(ByVal chuoi As String) As String
Dim chuoi_thu(2 To 8), chuoi_i, temp As String
Dim truong_hop, so_ngay, weekday, can1, can2 As Integer
temp = ""
For i = 1 To Len(chuoi)
chuoi_i = Right(Left(chuoi, i), 1)
If (StrComp(chuoi_i, "-") = 0) Then
can1 = CInt(Right(Left(chuoi, i - 1), 1))
can2 = CInt(Right(Left(chuoi, i + 1), 1))
For j = can1 + 1 To can2
temp = temp & Weekday_Style(j) & ","
Next
i = can2
Else
weekday = Weekday_Style(chuoi_i)
If (weekday <> "") Then
temp = temp & weekday & ","
End If
End If
Next
Weekday_Analysis = temp
End Function
Sub Create_Vehicles(ByVal Data_Address As Range, ByVal File_Name As String)
Dim FileNumber 'for a file
Dim vehicle, channel, sector, time1, time2, string_date, error_messsage As String
Dim hcm_group(1 To 4) As String
Dim so_ngay, num_vehicles, minute_resolution As Integer
Dim error As Boolean
FileNumber = FreeFile ' Get unused file
Open File_Name For Output As #FileNumber ' Create file name.
Print #FileNumber, "[GROUP]"
Print #FileNumber,
hcm_group(1) = "HTV7 (HCMC)"
hcm_group(2) = "HTV9 (HCMC)"
hcm_group(3) = "HTV2 (HCMC)"
hcm_group(4) = "HTV3 (HCMC)"
error_message = ""
error = True
For num_vehicles = 1 To Data_Address.Rows.Count - 1
vehicle = Data_Address.Cells(num_vehicles, 1)
Application.StatusBar = "Proccessing...Pos=" & vehicle
If (Len(vehicle) < 5) Then GoTo ke_tiep
channel = Application.VLookup(vehicle, Data_Address, 3, False)
sector = Application.VLookup(vehicle, Data_Address, 5, False)
time1 = istring3(istring3(vehicle, "_", 2), "-", 1)
time2 = istring3(istring3(vehicle, "_", 2), "-", 2)
string_date = Weekday_Analysis(istring3(vehicle, "_", 3))
so_ngay = Count_Text(",", string_date)
If (channel = hcm_group(1) Or channel = hcm_group(2) Or channel = hcm_group(3) Or channel = hcm_group(4)) Then
'infosys gioi han toi da 50 ki tu
'neu la HCM thi so phut la` 1p
minute_resolution = 1
error = False
Else
'If ((Minute(time1) Mod 5) > 0 Or (Minute(time2) Mod 5) > 0) Then
' error_message = error_message & vehicle & vbCrLf
' error = True
'Else
'cac thi truong khac la 15p
error = False
minute_resolution = 1
'End If
End If
If (Not error) Then
Print #FileNumber, "[VEHICLE]"
Print #FileNumber, Left(vehicle, 50) & vbTab & minute_resolution
For i = 1 To so_ngay
Print #FileNumber, channel & vbTab & sector & vbTab & istring3(string_date, ",", i) & vbTab & time1 & vbTab & time2
Next
End If
ke_tiep:
Next
If (Len(error_message) > 0) Then
MsgBox error_message, vbCritical, "ERROR - NOT MOD 15minute"
End If
Close #FileNumber ' Close file.
Application.StatusBar = "Proccessing...Finished"
End Sub
Sub CREATE_Multisupport()
frmVehicles.Show
End Sub
