Ghép dòng! (1 người xem)

[huonglien1901]

Chào mọi người!

Em có vấn đề cần nhờ mọi người giúp!

Em nêu rõ vấn đề:
Em có file này: trong file có những dòng nó bị lệch. em muốn nối kết quả lại như trong file em đã đưa ra kết quả! những dòng không lệch vẫn giữ nguyên, Khi nối dòng dòng lại thì xóa khoảng trắng đi.
Đây là vấn đề nhờ mọi người hỗ trợ!

Em cảm ơn mọi người nhiều!

 

[PacificPR]

Chào mọi người!

Em có vấn đề cần nhờ mọi người giúp!

Em nêu rõ vấn đề:
Em có file này: trong file có những dòng nó bị lệch. em muốn nối kết quả lại như trong file em đã đưa ra kết quả! những dòng không lệch vẫn giữ nguyên, Khi nối dòng dòng lại thì xóa khoảng trắng đi.
Đây là vấn đề nhờ mọi người hỗ trợ!

Em cảm ơn mọi người nhiều!

Bạn thử chạy cái Sub này xem có được không:

Sub Doremon()
    Dim sArr(), dArr(), i As Long, j As Long, Lkt As Long, Chuoi As String, Tmp
    With Sheet1
        sArr = .Range("A2", .Range("A65535").End(3)).Value
        ReDim dArr(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            Lkt = 0:    Chuoi = sArr(i, 1)
            If Chuoi Like "*" & "/" & "*" Then
                dArr(i, 1) = sArr(i, 1)
                GoTo 1
            End If
            If i <= UBound(sArr) - 2 Then
                Tmp = Split(Chuoi, " ")
                For j = 0 To UBound(Tmp)
                    If IsNumeric(Tmp(j)) = True Then
                        Exit For
                    Else
                        Lkt = Lkt + Len(Tmp(j)) + 1
                    End If
                Next j
                dArr(i, 1) = sArr(i + 2, 1) & " " & Mid(Chuoi, 1, Lkt) & sArr(i + 1, 1) & Mid(Chuoi, Lkt, Len(Chuoi))
                i = i + 2:
            End If
1:
        Next i
        .Range("B2").Resize(i - 1, 1).ClearContents
        .Range("B2").Resize(i - 1, 1) = dArr
    End With
End Sub

 

[Ba Tê]

If Chuoi Like "*" & "/" & "*" Then

Cái này rút gọn lại If Chuoi Like "*/*" Then
Xét cái dấu "/" này thì sẽ bị hỏi nữa, vì tôi nhớ là còn nhiều "tình huống" dữ liệu trong những bài hỏi trước.

 

[huonglien1901]

Cái này rút gọn lại If Chuoi Like "*/*" Then
Xét cái dấu "/" này thì sẽ bị hỏi nữa, vì tôi nhớ là còn nhiều "tình huống" dữ liệu trong những bài hỏi trước.

Dạ em không hỏi đâu anh trừ khi code nó không ra hoặc ra sai anh ơi!

em đã rút kinh nghiệm cho lần đăng bài nầy rồi! Anh Befaint đã dạy em!

 

[huonglien1901]

Bạn thử chạy cái Sub này xem có được không:

Sub Doremon()
    Dim sArr(), dArr(), i As Long, j As Long, Lkt As Long, Chuoi As String, Tmp
    With Sheet1
        sArr = .Range("A2", .Range("A65535").End(3)).Value
        ReDim dArr(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            Lkt = 0:    Chuoi = sArr(i, 1)
            If Chuoi Like "*" & "/" & "*" Then
                dArr(i, 1) = sArr(i, 1)
                GoTo 1
            End If
            If i <= UBound(sArr) - 2 Then
                Tmp = Split(Chuoi, " ")
                For j = 0 To UBound(Tmp)
                    If IsNumeric(Tmp(j)) = True Then
                        Exit For
                    Else
                        Lkt = Lkt + Len(Tmp(j)) + 1
                    End If
                Next j
                dArr(i, 1) = sArr(i + 2, 1) & " " & Mid(Chuoi, 1, Lkt) & sArr(i + 1, 1) & Mid(Chuoi, Lkt, Len(Chuoi))
                i = i + 2:
            End If
1:
        Next i
        .Range("B2").Resize(i - 1, 1).ClearContents
        .Range("B2").Resize(i - 1, 1) = dArr
    End With
End Sub

Dạ code ra đúng rồi anh ơi! Giờ em có nếu vấn đề ở trên khi nối dòng lại nhau ta xóa các khoảng trắng đi!

Em cảm ơn Anh!

 

[Ba Tê]

Dạ em không hỏi đâu anh trừ khi code nó không ra hoặc ra sai anh ơi!

em đã rút kinh nghiệm cho lần đăng bài nầy rồi! Anh Befaint đã dạy em!

Chắc là phải hỏi nữa!
Code trên còn chưa loại bỏ kết quả là dòng trống.
Bạn chạy thử cái Sub "Lu xu bu" này thử xem sao:

Public Sub GPE()
Dim sArr(), dArr(), i As Long, j As Long, K As Long, N As Long, R As Long, Txt As String, Tem As String, Tmp
sArr = Range("A2", Range("A2").End(xlDown)).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For i = 1 To R
    If Len(sArr(i, 1)) > 30 Then
        K = K + 1:  dArr(K, 1) = sArr(i, 1)
    Else
        Tem = "":   Txt = dArr(K, 1):   Tmp = Split(Txt)
        For j = 0 To UBound(Tmp)
            If Not IsNumeric(Tmp(j)) Then
                Tem = Tem & Tmp(j) & " "
            Else
                Tem = Tem & sArr(i, 1): N = j + 1: Exit For
            End If
        Next j
        For j = N To UBound(Tmp)
            Tem = Tem & " " & Tmp(j)
        Next j
        Tem = sArr(i + 1, 1) & " " & Tem:   dArr(K, 1) = Tem:   i = i + 1
    End If
Next i
Range("C2").Resize(K) = dArr
End Sub

 

[huonglien1901]

Chắc là phải hỏi nữa!
Code trên còn chưa loại bỏ kết quả là dòng trống.
Bạn chạy thử cái Sub "Lu xu bu" này thử xem sao:

Public Sub GPE()
Dim sArr(), dArr(), i As Long, j As Long, K As Long, N As Long, R As Long, Txt As String, Tem As String, Tmp
sArr = Range("A2", Range("A2").End(xlDown)).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For i = 1 To R
    If Len(sArr(i, 1)) > 30 Then
        K = K + 1:  dArr(K, 1) = sArr(i, 1)
    Else
        Tem = "":   Txt = dArr(K, 1):   Tmp = Split(Txt)
        For j = 0 To UBound(Tmp)
            If Not IsNumeric(Tmp(j)) Then
                Tem = Tem & Tmp(j) & " "
            Else
                Tem = Tem & sArr(i, 1): N = j + 1: Exit For
            End If
        Next j
        For j = N To UBound(Tmp)
            Tem = Tem & " " & Tmp(j)
        Next j
        Tem = sArr(i + 1, 1) & " " & Tem:   dArr(K, 1) = Tem:   i = i + 1
    End If
Next i
Range("C2").Resize(K) = dArr
End Sub

Dạ code ra đúng rồi anh ơi! Em cảm ơn Anh rất nhiều!