Ghép dữ liệu 2 cột thành 1 cột và xóa dòng kết quả nếu cột 1 bằng rỗng (1 người xem)

[huynhphi2017]

Chào các anh chị !

Em có việc nhờ các anh chị chuyển đổi thành vba dùm
Cụ thể như file đính kèm :
Công việc 1 : ghép dữ liệu 2 cột A và C vào cột D ( theo định dạng trong file )
Công việc 2 : xóa tất cả các dòng dữ liệu nếu Cột A là rỗng

Do công việc phải làm việc trên bảng tính lớn, khoảng hơn 10000 dòng nên nếu dùng hàm thì file quá nặng
Em mới chập chững biết về vba nên nhờ các anh chị giúp đỡ code vba với.

Cảm ơn các anh chị đã đọc bài !

 

[giaiphap]

Chào các anh chị !

Em có việc nhờ các anh chị chuyển đổi thành vba dùm
Cụ thể như file đính kèm :
Công việc 1 : ghép dữ liệu 2 cột A và C vào cột D ( theo định dạng trong file )
Công việc 2 : xóa tất cả các dòng dữ liệu nếu Cột A là rỗng

Do công việc phải làm việc trên bảng tính lớn, khoảng hơn 10000 dòng nên nếu dùng hàm thì file quá nặng
Em mới chập chững biết về vba nên nhờ các anh chị giúp đỡ code vba với.

Cảm ơn các anh chị đã đọc bài !

Bạn xem thử đúng yêu cầu của mình chưa.

 

[Ba Tê]

Chào các anh chị !

Em có việc nhờ các anh chị chuyển đổi thành vba dùm
Cụ thể như file đính kèm :
Công việc 1 : ghép dữ liệu 2 cột A và C vào cột D ( theo định dạng trong file )
Công việc 2 : xóa tất cả các dòng dữ liệu nếu Cột A là rỗng

Do công việc phải làm việc trên bảng tính lớn, khoảng hơn 10000 dòng nên nếu dùng hàm thì file quá nặng
Em mới chập chững biết về vba nên nhờ các anh chị giúp đỡ code vba với.

Cảm ơn các anh chị đã đọc bài !

2 công việc cùng lúc hay 2 công việc khác nhau?
Nếu chỉ làm 1 lúc thì xem code này:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
sArr = Sheet1.Range("A2", Sheet1.Range("A60000").End(xlUp)).Resize(, 3).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = sArr(I, 2)
        dArr(K, 3) = sArr(I, 3)
        dArr(K, 4) = sArr(I, 1) & " " & sArr(I, 3) '---------------- Có khoảng cách khi nối chuỗi'
    End If
Next I
Sheet2.Range("A2:D10000").ClearContents
Sheet2.Range("A2").Resize(K, 4) = dArr
End Sub

Nếu không muốn có khoảng cách thì bỏ nó đi.

 

[Phuocam]

chuyển đổi thành vba dùm..

Thử

Public Sub test()
Dim lastRow As Long
Dim i As Long, j As Long, k As Long
Dim Arr1, Arr2
    With Sheets("Sheet1")
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Arr1 = .Range("A1:D" & lastRow)
    End With
    ReDim Arr2(1 To UBound(Arr1, 1), 1 To 4)
    For i = 1 To UBound(Arr1, 1)
        If Arr1(i, 1) <> "" Then
            Arr1(i, 4) = Arr1(i, 1) & Format(Arr1(i, 3), "dd/mm/yyyy")
            k = k + 1
                For j = 1 To 4
                    Arr2(k, j) = Arr1(i, j)
                Next
        End If
    Next
    Sheet2.Range("A1").Resize(i - 1, 4) = Arr1
    Sheet2.Columns("B").NumberFormat = "h:mm:ss"
    Sheet3.Range("A1").Resize(k, 4) = Arr2
     Sheet3.Columns("B").NumberFormat = "h:mm:ss"
End Sub

 

[huynhphi2017]

Bạn xem thử đúng yêu cầu của mình chưa.

2 công việc cùng lúc hay 2 công việc khác nhau?
Nếu chỉ làm 1 lúc thì xem code này:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
sArr = Sheet1.Range("A2", Sheet1.Range("A60000").End(xlUp)).Resize(, 3).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = sArr(I, 2)
        dArr(K, 3) = sArr(I, 3)
        dArr(K, 4) = sArr(I, 1) & " " & sArr(I, 3) '---------------- Có khoảng cách khi nối chuỗi'
    End If
Next I
Sheet2.Range("A2:D10000").ClearContents
Sheet2.Range("A2").Resize(K, 4) = dArr
End Sub

Nếu không muốn có khoảng cách thì bỏ nó đi.

Thử

Public Sub test()
Dim lastRow As Long
Dim i As Long, j As Long, k As Long
Dim Arr1, Arr2
    With Sheets("Sheet1")
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Arr1 = .Range("A1:D" & lastRow)
    End With
    ReDim Arr2(1 To UBound(Arr1, 1), 1 To 4)
    For i = 1 To UBound(Arr1, 1)
        If Arr1(i, 1) <> "" Then
            Arr1(i, 4) = Arr1(i, 1) & Format(Arr1(i, 3), "dd/mm/yyyy")
            k = k + 1
                For j = 1 To 4
                    Arr2(k, j) = Arr1(i, j)
                Next
        End If
    Next
    Sheet2.Range("A1").Resize(i - 1, 4) = Arr1
    Sheet2.Columns("B").NumberFormat = "h:mm:ss"
    Sheet3.Range("A1").Resize(k, 4) = Arr2
     Sheet3.Columns("B").NumberFormat = "h:mm:ss"
End Sub

Chào các anh buổi sáng vui vẻ.
Theo code các anh hỗ trợ em đã làm được rồi ạ.
Cảm ơn các anh nhiều nhiều.

Em còn thêm những công việc 3,4,5 nữa, không biết có nên post bài ở đây luôn hay chuyển qua Chủ đề khác ???

Em liều mạng post luôn nhé, đừng nhằn em nó tội nghiệp, còn nhỏ dại chưa biết gì khì khì

 

[giaiphap]

Chào các anh buổi sáng vui vẻ.
Theo code các anh hỗ trợ em đã làm được rồi ạ.
Cảm ơn các anh nhiều nhiều.

Em còn thêm những công việc 3,4,5 nữa, không biết có nên post bài ở đây luôn hay chuyển qua Chủ đề khác ???

Em liều mạng post luôn nhé, đừng nhằn em nó tội nghiệp, còn nhỏ dại chưa biết gì khì khì

Công việc 3, 4 và 5 có liên quan gì với chủ đề này không? nếu có thì có thể nhờ ở đây, còn không thì nên lập topic khác.

 

[huynhphi2017]

Chào các anh !

Em xin thêm file nhờ giúp đỡ tiếp
Nội dung em đã ghi cụ thể trong Sheet1 của file.

Cảm ơn các anh chị trước !

 

[be_09]

Chào các anh chị !

Em có việc nhờ các anh chị chuyển đổi thành vba dùm
Cụ thể như file đính kèm :
Công việc 1 : ghép dữ liệu 2 cột A và C vào cột D ( theo định dạng trong file )
Công việc 2 : xóa tất cả các dòng dữ liệu nếu Cột A là rỗng

Do công việc phải làm việc trên bảng tính lớn, khoảng hơn 10000 dòng nên nếu dùng hàm thì file quá nặng
Em mới chập chững biết về vba nên nhờ các anh chị giúp đỡ code vba với.

Cảm ơn các anh chị đã đọc bài !

Anh sửa code của giaiphap lại 1 tí cho ngắn gọn và chỉ dùng 1 nút.

Sub Ghep_Cot()
    Dim Arr(), dArr(), i As Long, k As Long
    Sheet1.Range("A2").CurrentRegion.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    With Sheet1
        Arr = .Range("A2:C" & .Range("C65000").End(xlUp).Row).Value
        ReDim dArr(1 To UBound(Arr, 1))
        For i = 1 To UBound(Arr, 1)
            k = k + 1
            If Arr(i, 1) <> Empty Then dArr(k) = Arr(i, 1) & Format(Arr(i, 3), "DD/MM/YYYY")
        Next i
        .Range("D2").Resize(UBound(dArr, 1)) = Application.Transpose(dArr)
    End With
End Sub