Datcdt2k9
Thành viên hoạt động
- Tham gia
- 27/12/19
- Bài viết
- 109
- Được thích
- 11
Chào anh chị, em đang gặp vấn đề về file excel đang dùng:
+ Khi run code nếu kí tự update vào cột C đều là chữ hoa thì code chạy đúng, khi gặp trường hợp chữ thường và chữ vừa hoa vừa thường code sẽ tách data sai
=> nhờ mọi người sửa code để có thể chạy đúng tất cả trường hợp trên.
+ Khi run code thì kết quả tách ra ở cột C vẫn giữ nguyên đuôi .zip ( code hiện tại không có .zip khi tách ra)
=> Mong các anh chị giúp đỡ. Em xin cảm ơn
Đây là code em muốn nhờ mọi người edit giúp ạ, trong file upload cũng có sẵn code rồi ạ :
Sub tach_chuoi_KOH()
Dim ws, wsh As Worksheet
Dim i, n, j, lr, k, imin, imax As Long
Dim PGM, s, dai, sdai, iType, CDT, Model, Slide As String
Set wsh = Sheet1
Set ws = Sheet2
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
lr = wsh.Cells(Rows.Count, 3).End(xlUp).Row
k = WorksheetFunction.Max(ws.Cells(Rows.Count, 3).End(xlUp).Row + 1, 2)
'ws.Range("a2:G" & Rows.Count).ClearContents
'ws.Range("a2:G" & Rows.Count).Borders.Value = 0
For i = 2 To lr
PGM = wsh.Cells(i, "C").Value
PGM = Mid(PGM, 2, Len(PGM) - 5)
Model = Left(PGM, 7)
If Left(Right(PGM, 2), 1) = "X" Then
iType = Right(PGM, 2)
n = InStrRev(PGM, "_", Len(PGM) - 3)
If InStr(PGM, "VQ") = 0 Then 'check VQ
PGM = Left(PGM, n) & "VQ" & Right(PGM, Len(PGM) - n)
End If
n = InStrRev(PGM, "_", Len(PGM) - 3)
dai = Mid(PGM, n + 1, Len(PGM) - n - 3)
Else
iType = ""
n = InStrRev(PGM, "_")
If InStr(PGM, "VQ") = 0 Then 'check VQ
PGM = Left(PGM, n) & "VQ" & Right(PGM, Len(PGM) - n)
End If
n = InStrRev(PGM, "_")
dai = Right(PGM, Len(PGM) - n)
End If
sdai = Right(dai, Len(dai) - InStr(dai, "FA") - 1)
imin = Val(sdai)
imax = Val(Right(sdai, 3))
CDT = Left(dai, InStr(dai, "FA") + 1)
If InStr(PGM, "BM") <> 0 Or InStr(PGM, "TM") <> 0 Then
Slide = "M"
ElseIf InStr(PGM, "BS") <> 0 Or InStr(PGM, "TS") <> 0 Then
Slide = "S"
Else
Slide = ""
End If
For j = 0 To imax - imin
With ws
.Cells(k, "A").Value = k - 1
.Cells(k, "B").Value = Model & CDT & WorksheetFunction.Text(imin + j, "000")
.Cells(k, "C").Value = PGM
.Cells(k, "D").Value = dai
.Cells(k, "E").Value = CDT & WorksheetFunction.Text(imin + j, "000")
.Cells(k, "F").Value = iType
.Cells(k, "G").Value = Slide
.Range("A" & k & ":G" & k).Borders.Value = 1
End With
k = k + 1
Next j
Next i
ws.Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
+ Khi run code nếu kí tự update vào cột C đều là chữ hoa thì code chạy đúng, khi gặp trường hợp chữ thường và chữ vừa hoa vừa thường code sẽ tách data sai
=> nhờ mọi người sửa code để có thể chạy đúng tất cả trường hợp trên.
+ Khi run code thì kết quả tách ra ở cột C vẫn giữ nguyên đuôi .zip ( code hiện tại không có .zip khi tách ra)
=> Mong các anh chị giúp đỡ. Em xin cảm ơn
Đây là code em muốn nhờ mọi người edit giúp ạ, trong file upload cũng có sẵn code rồi ạ :
Sub tach_chuoi_KOH()
Dim ws, wsh As Worksheet
Dim i, n, j, lr, k, imin, imax As Long
Dim PGM, s, dai, sdai, iType, CDT, Model, Slide As String
Set wsh = Sheet1
Set ws = Sheet2
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
lr = wsh.Cells(Rows.Count, 3).End(xlUp).Row
k = WorksheetFunction.Max(ws.Cells(Rows.Count, 3).End(xlUp).Row + 1, 2)
'ws.Range("a2:G" & Rows.Count).ClearContents
'ws.Range("a2:G" & Rows.Count).Borders.Value = 0
For i = 2 To lr
PGM = wsh.Cells(i, "C").Value
PGM = Mid(PGM, 2, Len(PGM) - 5)
Model = Left(PGM, 7)
If Left(Right(PGM, 2), 1) = "X" Then
iType = Right(PGM, 2)
n = InStrRev(PGM, "_", Len(PGM) - 3)
If InStr(PGM, "VQ") = 0 Then 'check VQ
PGM = Left(PGM, n) & "VQ" & Right(PGM, Len(PGM) - n)
End If
n = InStrRev(PGM, "_", Len(PGM) - 3)
dai = Mid(PGM, n + 1, Len(PGM) - n - 3)
Else
iType = ""
n = InStrRev(PGM, "_")
If InStr(PGM, "VQ") = 0 Then 'check VQ
PGM = Left(PGM, n) & "VQ" & Right(PGM, Len(PGM) - n)
End If
n = InStrRev(PGM, "_")
dai = Right(PGM, Len(PGM) - n)
End If
sdai = Right(dai, Len(dai) - InStr(dai, "FA") - 1)
imin = Val(sdai)
imax = Val(Right(sdai, 3))
CDT = Left(dai, InStr(dai, "FA") + 1)
If InStr(PGM, "BM") <> 0 Or InStr(PGM, "TM") <> 0 Then
Slide = "M"
ElseIf InStr(PGM, "BS") <> 0 Or InStr(PGM, "TS") <> 0 Then
Slide = "S"
Else
Slide = ""
End If
For j = 0 To imax - imin
With ws
.Cells(k, "A").Value = k - 1
.Cells(k, "B").Value = Model & CDT & WorksheetFunction.Text(imin + j, "000")
.Cells(k, "C").Value = PGM
.Cells(k, "D").Value = dai
.Cells(k, "E").Value = CDT & WorksheetFunction.Text(imin + j, "000")
.Cells(k, "F").Value = iType
.Cells(k, "G").Value = Slide
.Range("A" & k & ":G" & k).Borders.Value = 1
End With
k = k + 1
Next j
Next i
ws.Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
