So sánh và sửa số liệu theo điều kiện?

Hoàng Nhật Phương · 13/1/19

Xin chào các bạn,
Nhờ các bạn giúp đỡ tôi trường hợp trong tập tin gửi kèm gửi với ạ.

Hoàng Nhật Phương · 14/1/19

Tối nhất nên sửa lại là:

PHP:

Sub sosanh2()
  Dim Arr, T, lr&, i&, LenStr&, RecentStr$
  With Sheets("Sheet1") 'Không nên viết là Sheet1 <> Excel Tiếng Việt
       lr = .Range("C" & Rows.Count).End(xlUp).Row
       If lr < 2 Then Exit Sub
       Arr = .Range("C2:C" & lr).Value
       For i = 1 To UBound(Arr)
          LenStr& = Len(Arr(i, 1))
          T = Split(Arr(i, 1), "/")
          If UBound(T) > 2 And LenStr& > 30 Then RecentStr$ = T(3)
          If UBound(T) > 1 And LenStr& < 30 And RecentStr$ <> vbNullString Then _
           T(2) = RecentStr$: Arr(i, 1) = Join(T, "/")
          If UBound(T) < 3 Or LenStr& < 30 Then RecentStr$ = vbNullString
      Next i
     .Range("G2:G" & lr).Value = Arr
  End With
End Sub

Cảm ơn HeSanbi nhiều ạ,
OT sẽ thử lại với nhiều trường hợp, nếu có vấn đề gì OT sẽ thông tin lại trong chủ đề này ạ.

HeSanbi · 14/1/19

HieuCD đã viết:
Hay quá, có cách nào giảm bớt IF không, code càng tuyệt vời hơn, dể đọc hơn

Những điều kiện ràng buộc là bắt buộc, nên không thể giảm bớt If. Không biết anh có phương án nào không?

HieuCD · 14/1/19

HeSanbi đã viết:
Những điều kiện ràng buộc là bắt buộc, nên không thể giảm bớt If. Không biết anh có phương án nào không?

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

Mã:

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

Đem 2 Split ra ngoài If, thêm 2 điều kiện Ubound vào IF

HeSanbi · 14/1/19

HieuCD đã viết:
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

Mã:

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

Đem 2 Split ra ngoài If, thêm 2 điều kiện Ubound vào IF

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.
Có lẽ thêm 2 điều kiện sau thì code của snow25 sẽ ổn:

Mã:

If a > 30 And b <= 30 And Arr(i, 1) Like "*/*/*/*" And Arr(i + 1, 1) Like "*/*/*" Then

Lúc này thì Split sẽ không được thực hiện trước thay vì đưa ra ngoài

CHAOQUAY · 15/1/19

HeSanbi đã viết:
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.
Có lẽ thêm 2 điều kiện sau thì code của snow25 sẽ ổn:

Mã:

If a > 30 And b <= 30 And Arr(i, 1) Like "*/*/*/*" And Arr(i + 1, 1) Like "*/*/*" Then

Lúc này thì Split sẽ không được thực hiện trước thay vì đưa ra ngoài

Cái b <= 30 có lẽ thừa dấu "="
Về lệnh split, chưa chắc code của bạn đã nhẹ hơn của @snow25 . Theo file bài 1, của bạn thực hiện split() 20 lần không cần điều kiện ràng buộc. Của @snow25 thi khi nào a>30 & b<30 mới thực thi split() nên chắc chắn sẽ thực hiện < 20 kể cả mỗi lần @snow25 tách 2 mảng.

HieuCD · 15/1/19

Dùng code của bạn @snow25 thêm vài lệnh

Mã:

Sub 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 Sub

Hoàng Nhật Phương · 15/1/19

HieuCD đã viết:

Dùng code của bạn @snow25 thêm vài lệnh

Mã:

Sub 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 Sub

Cháu cảm ơn bác HieuCD nhiều ạ,
Code chạy nhanh và kết quả chính xác ạ.

HeSanbi · 15/1/19

CHAOQUAY đã viết:
Cái b <= 30 có lẽ thừa dấu "="

Vậy bạn thử để chuỗi dài đúng 30 xem sao, điều kiện trên dưới đủ

CHAOQUAY · 15/1/19

HeSanbi đã viết:
Vậy bạn thử để chuỗi dài đúng 30 xem sao, điều kiện trên dưới đủ

Đây là điều kiện chủ thớt đưa ra trong file bài 1, không cần thử.

HeSanbi · 15/1/19

Nguyễn Hoàng Oanh Thơ
Không biết vì sao đúng 30 lại không xử lý,
Vì thấy điều kiện bỏ sót chuỗi dài đúng bằng 30 nên tôi nghĩ, người đặt điều kiện bị thiếu sót
Nếu "ghét" số 30 thì bỏ dấu "=" thôi

Hoàng Nhật Phương · 15/1/19

HeSanbi đã viết:
Nguyễn Hoàng Oanh Thơ
Không biết vì sao đúng 30 lại không xử lý,
Vì thấy điều kiện bỏ sót chuỗi dài đúng bằng 30 nên tôi nghĩ, người đặt điều kiện bị thiếu sót
Nếu "ghét" số 30 thì bỏ dấu "=" thôi

Trước hết Oanh Thơ xin cảm ơn Bác @HieuCD và hai Bạn @snow25 ,@HeSanbi đã giúp đỡ.
Cả 3code của Bác và hai Bạn đều xử lý rất nhanh và kết quả chính xác rồi, nên OT cũng không có ý kiến hay mong muốn gì thêm nữa ạ.
Nhưng vì mọi người vẫn bàn luận để cùng học hỏi nên OT chỉ biết theo dõi lắng nghe thôi ạ .
----

Không biết vì sao đúng 30 lại không xử lý,

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 ơn HeSanbi đã gợi ý đưa ra những tình huống xử lý lỗi có thể xảy ra.

Hoàng Nhật Phương · 15/1/19

Xin chào Bác HieuCD và các Bạn,
Với nguồn dữ liệu dạng bài 1, hiện OT vẫn còn vướng mắc một trường hợp nữa (xin được đề cập trong file gửi kèm)
Kính mong lại nhận được sự giúp đỡ của mọi người ạ.

befaint · 15/1/19

HieuCD · 16/1/19

befaint đã viết:
-

Có thể chạy chậm do em "j" không làm gì, đứng ngáng đường

befaint · 16/1/19

HieuCD đã viết:
Có thể chạy chậm do em "j" không làm gì, đứng ngáng đường

Có một em "j" đứng làm cảnh, em sửa lại rồi.

Em "j" để tránh trường hợp sau khi thay sẽ thay đổi từ 29 ký tự thành 31 ký tự (tức là đã xử lý rồi thì không xét nữa).

CHAOQUAY · 16/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào Bác HieuCD và các Bạn,
Với nguồn dữ liệu dạng bài 1, hiện OT vẫn còn vướng mắc một trường hợp nữa (xin được đề cập trong file gửi kèm)
Kính mong lại nhận được sự giúp đỡ của mọi người ạ.

Thử tìm theo một cách khác

Mã:

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 Sub

HieuCD · 16/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào Bác HieuCD và các Bạn,
Với nguồn dữ liệu dạng bài 1, hiện OT vẫn còn vướng mắc một trường hợp nữa (xin được đề cập trong file gửi kèm)
Kính mong lại nhận được sự giúp đỡ của mọi người ạ.

Hy vọng dữ liệu không có ký tự"##"

Mã:

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

Ba Tê · 16/1/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào Bác HieuCD và các Bạn,
Với nguồn dữ liệu dạng bài 1, hiện OT vẫn còn vướng mắc một trường hợp nữa (xin được đề cập trong file gửi kèm)
Kính mong lại nhận được sự giúp đỡ của mọi người ạ.

Bạn thử Sub này xem sao.

PHP:

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 Sub

Hoàng Nhật Phương · 16/1/19

Xin cảm ơn Thầy/Bác và các Bạn nhiều ạ,
Oanh Thơ(OT) đã test thử kết quả,tất cả các code trong bài đều rất nhanh và kết quả đúng với mong muốn của OT rồi ạ.
---------
Thầy @Ba Tê xem giúp con kết quả tại các dòng: 7,11,13 chưa đúng với kết quả mẫu Thầy ạ.
Con cảm ơn Thầy.

HieuCD · 16/1/19

Ba Tê đã viết:

Bạn thử Sub này xem sao.

PHP:

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 Sub

Nếu có dữ liệu như dạng sau thì hơi mệt
50055504024577/57200H20 0000QC/57200H20 0000QCBR/20/ /
57200H20 0000/ QC/20

So sánh và sửa số liệu theo điều kiện?

Thành viên gắn bó

File đính kèm

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Chuyên gia GPE

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Thành viên gắn bó

File đính kèm

|||||||||||||

File đính kèm

Chuyên gia GPE

|||||||||||||

Thành viên gắn bó

Chuyên gia GPE

Cạo Rồi Khỏi Gội

Thành viên gắn bó

Chuyên gia GPE

Facebook

Group