Cảm ơn HeSanbi nhiều ạ,
Mình thấy code của bạn Snow25 dùng 1 IF, nên nghỉ code của bạn cũng có thể dùng 1 hoặc tối đa 2 IF
Sub sosanh()
Dim arr, T As String, at, T1 As String
Dim lr As Long, i As Long, a As Integer, b As Integer
With Sheet1
lr = .Range("C" & Rows.Count).End(xlUp).Row
arr = .Range("C2:C" & lr).Value
For i = 1 To UBound(arr, 1) - 1
a = Len(arr(i, 1)): b = Len(arr(i + 1, 1))
If a > 30 And b < 30 Then
T = Split(arr(i, 1), "/")(3)
at = Split(arr(i + 1, 1), "/")
arr(i + 1, 1) = at(0) & "/" & at(1) & "/" & T
End If
Next i
.Range("G2:G" & lr).Value = arr
End With
End Sub
Code của snow25 Với việc bớt đi một vòng lặp để so sánh cùng lúc hai giá trị của mảng, 2 biến nhận Lenght, 2 Mảng nhận Split thì gánh nặng của code đã tăng gấp đôi.
If a > 30 And b <= 30 And Arr(i, 1) Like "*/*/*/*" And Arr(i + 1, 1) Like "*/*/*" ThenSub DoiThamSo()
Dim sArr(), S1, S2
Dim eRow As Long, sRow As Long, i As Long
Dim tmp1 As String, tmp2 As String
With Sheets("Sheet1")
eRow = .Range("C" & Rows.Count).End(xlUp).Row
If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
sArr = .Range("C2:C" & eRow).Value
sRow = UBound(sArr, 1)
For i = 1 To sRow - 1
tmp1 = sArr(i, 1): tmp2 = sArr(i + 1, 1)
If Len(tmp1) > 30 And Len(tmp2) < 30 Then
S1 = Split(tmp1, "/")
S2 = Split(tmp2, "/")
If UBound(S1) > 2 And UBound(S2) > 1 Then
sArr(i + 1, 1) = S2(0) & "/" & S2(1) & "/" & S1(3)
End If
i = i + 1
End If
Next i
.Range("E2:E" & eRow).Value = sArr
End With
End SubCháu cảm ơn bác HieuCD nhiều ạ,
Đây là điều kiện chủ thớt đưa ra trong file bài 1, không cần thử.
Dạ, chỉ là do trong thực tế công việc mà OT thấy rằng dữ liệu của "dòng 1 chưa bao giờ <35,dòng 2 chưa bao giờ >25" lên OT lấy con số 30 để làm mốc thôi ạ, vì vậy cũng không căn ke tỷ mỷ đến trường hợp =30 thì xếp vào trường hợp nào ạ.
Có một em "j" đứng làm cảnh, em sửa lại rồi.Có thể chạy chậm do em "j" không làm gì, đứng ngáng đường
Thử tìm theo một cách khác
Sub abcd()
Dim Nguon
Dim Tach1 As String, Tach2 As String
Dim Kq
Dim i As Long, j As Long, k, x, z
Nguon = Sheet1.Range("b2:b27")
ReDim Kq(1 To UBound(Nguon), 1 To 1)
Kq(1, 1) = Nguon(1, 1)
i = 2
Do While i <= UBound(Nguon)
k = 0
j = Len(Nguon(i - 1, 1))
If Len(Nguon(i, 1)) < 30 Then
If j > 30 Then
z = InStr(Nguon(i - 1, 1), "/ /")
Tach1 = Mid(Nguon(i - 1, 1), z - 8, 2)
If Tach1 = "QC" Then
x = InStr(Nguon(i, 1), "/ /")
Tach2 = Mid(Nguon(i, 1), x - 2, 2)
If Tach2 <> "QC" Then
Kq(i, 1) = Left(Nguon(i, 1), x - 1) & "QC" & Right(Nguon(i, 1), Len(Nguon(i, 1)) - x + 1)
Kq(i + 1, 1) = Nguon(i + 1, 1)
k = 1
End If
End If
End If
End If
If k Then 'Sua lai
k = 0: i = i + 2
Else
Kq(i, 1) = Nguon(i, 1)
i = i + 1
End If
Loop
Sheet1.Range("g2").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
End SubHy vọng dữ liệu không có ký tự"##"
Sub Input_QC()
Dim sArr(), tmp As String, iStr As String
Dim i As Long, sRow As Long, j As Integer
With Sheet1
i = .Range("B65000").End(xlUp).Row
If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
sArr = .Range("B2:B" & i).Value
sRow = UBound(sArr, 1)
For i = 2 To sRow
tmp = sArr(i - 1, 1): iStr = sArr(i, 1)
If Len(tmp) > 30 And Len(iStr) < 30 Then
iStr = Application.Substitute(iStr, "/", "##/", 1)
If InStr(1, iStr, "QC##/") = 0 Then
j = InStr(1, Application.Substitute(tmp, "/", "###", 3), "###")
If j > 5 Then
If Mid(tmp, j - 5, 2) = "QC" Then
sArr(i, 1) = Replace(iStr, "##/", "QC/")
End If
End If
End If
i = i + 1
End If
Next i
.Range("C2").Resize(sRow).Value = sArr
End With
End Sub
Bạn thử Sub này xem sao.
Public Sub sGpe()
Dim sArr(), dArr(), I As Long, N As Long, R As Long
sArr = Range("B2", Range("B2").End(xlDown)).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
dArr(1, 1) = sArr(1, 1)
For I = 2 To R
dArr(I, 1) = sArr(I, 1)
If Len(dArr(I, 1)) < 30 Then
If Not dArr(I, 1) Like "*QC/*" Then
If Len(dArr(I - 1, 1)) > 30 Then
If dArr(I - 1, 1) Like "*/*/*QC*" Then
N = InStr(dArr(I, 1), "/")
dArr(I, 1) = Left(dArr(I, 1), N - 1) & "QC" & Mid(dArr(I, 1), N)
End If
End If
End If
End If
Next I
Range("C2").Resize(R) = dArr
End SubNếu có dữ liệu như dạng sau thì hơi mệt
