Lọi bỏ chuỗi theo điều kiện (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

HocVBAExcel

Thành viên mới
Tham gia
17/4/15
Bài viết
40
Được thích
1
Giới tính
Nam
Nếu cột D rỗng thì cập nhật chiều dài cột C vào cột D chỉ lấy số thôi chằng hạn 265mm thì lấy 265 .
Ngược lại nếu D có số lượng và có chiều dài ở cột C thì Cột B nối chuổi với cột C vi dụ như cột B8=3648A-800
Các Anh Chi xem file đính kèm
 

File đính kèm

Mã:
Sub Tinh()
Dim i, j, m, k As Long, sArr
sArr = Range([B4], [B65000].End(xlUp)).Resize(, 3)
ReDim dArr(1 To UBound(sArr), 1 To 3)
For i = 1 To UBound(sArr)
 k = k + 1
 dArr(k, 2) = sArr(i, 2)
 If sArr(i, 3) = "" Then
    dArr(k, 1) = sArr(i, 1)
    For j = 1 To Len(sArr(i, 2))
        If Mid(sArr(i, 2), j, 1) Like "#" Then dArr(k, 3) = dArr(k, 3) & Mid(sArr(i, 2), j, 1)
    Next j
 Else
    dArr(k, 3) = sArr(i, 3)
    If sArr(i, 2) <> "" Then
        For m = 1 To Len(sArr(i, 2))
            If Mid(sArr(i, 2), m, 1) Like "#" Then dArr(k, 1) = dArr(k, 1) & Mid(sArr(i, 2), m, 1)
        Next m
        dArr(k, 1) = sArr(i, 1) & "-" & dArr(k, 1)
    Else
        dArr(k, 1) = sArr(i, 1)
    End If
End If
Next i
[F4:H65000].ClearContents
[F4].Resize(k, 3).Value = dArr
End Sub
Bạn kiểm tra lại F8,F9 đâu có như bạn nói việc ghép nối phải như F10, F12
 
Upvote 0
Mã:
Sub Tinh()
Dim i, j, m, k As Long, sArr
sArr = Range([B4], [B65000].End(xlUp)).Resize(, 3)
ReDim dArr(1 To UBound(sArr), 1 To 3)
For i = 1 To UBound(sArr)
 k = k + 1
 dArr(k, 2) = sArr(i, 2)
 If sArr(i, 3) = "" Then
    dArr(k, 1) = sArr(i, 1)
    For j = 1 To Len(sArr(i, 2))
        If Mid(sArr(i, 2), j, 1) Like "#" Then dArr(k, 3) = dArr(k, 3) & Mid(sArr(i, 2), j, 1)
    Next j
 Else
    dArr(k, 3) = sArr(i, 3)
    If sArr(i, 2) <> "" Then
        For m = 1 To Len(sArr(i, 2))
            If Mid(sArr(i, 2), m, 1) Like "#" Then dArr(k, 1) = dArr(k, 1) & Mid(sArr(i, 2), m, 1)
        Next m
        dArr(k, 1) = sArr(i, 1) & "-" & dArr(k, 1)
    Else
        dArr(k, 1) = sArr(i, 1)
    End If
End If
Next i
[F4:H65000].ClearContents
[F4].Resize(k, 3).Value = dArr
End Sub
Bạn kiểm tra lại F8,F9 đâu có như bạn nói việc ghép nối phải như F10, F12
Đúng rồi bạn mình Cám ơn nhiều
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom