Xin chỉ cách dán vào ô Merged Cell. Thanks

[tran_hung]

Mình có file dữ liệu nguồn và file làm việc chứa công thức tính. Khi mình muốn copy file dữ liệu và dán file làm việc thì phải làm thủ công từng mã hàng vì file làm việc là file đã trộn 3 ô lại với nhau. Rất lâu và dễ sai, các anh chị và thầy cô có cách dán nào nhanh xin chỉ lại dùm. Chân thành cám ơn

 

[congnt92]

Mình có file dữ liệu nguồn và file làm việc chứa công thức tính. Khi mình muốn copy file dữ liệu và dán file làm việc thì phải làm thủ công từng mã hàng vì file làm việc là file đã trộn 3 ô lại với nhau. Rất lâu và dễ sai, các anh chị và thầy cô có cách dán nào nhanh xin chỉ lại dùm. Chân thành cám ơn

Bạn thử tham khảo. Mình cũng không rõ có cách copy dán nào tiện hơn mà không dùng hàm không.

 

[phulien1902]

Mình có file dữ liệu nguồn và file làm việc chứa công thức tính. Khi mình muốn copy file dữ liệu và dán file làm việc thì phải làm thủ công từng mã hàng vì file làm việc là file đã trộn 3 ô lại với nhau. Rất lâu và dễ sai, các anh chị và thầy cô có cách dán nào nhanh xin chỉ lại dùm. Chân thành cám ơn

Thử:

Sub TH()
    Application.ScreenUpdating = False
    Call abc
    Call Merge_abc
    Application.ScreenUpdating = True
End Sub
Sub abc()
    Dim i, LR, Cll
    LR = Sheets(1).Cells(Rows.Count, 6).End(3).Rows
    i = 4
    [B4:B51].UnMerge
    On Error Resume Next
    With Sheets(1)
        For Each Cll In Sheets(2).Range("A2", Sheets(2).Cells(Rows.Count, 1).End(3))
            .Cells(i, 2) = Cll.Value
            i = i + 3
        Next
    End With
    With Sheets(1).Range("B4:B" & Range("f" & Rows.Count).End(3).Row)
        .SpecialCells(4).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
    For i = LR To 4
        If Cells(i, 2) = Cells(i - 1, 2) Then
            Range(Cells(i, 2), Cells(i - 1, 2)).Merge
        End If
    Next i
End Sub
Sub Merge_abc()
    Dim LR, LR2 As Long, i As Long
    LR = Cells(Rows.Count, "B").End(xlUp).Row
    i = 4
    Do While i < LR
        LR2 = 1
        Do While Cells(i, 2) = Cells(i + LR2, 2)
            LR2 = LR2 + 1
        Loop
        If LR2 > 1 Then
            Cells(i + 1, 2).Resize(LR2 - 1).ClearContents
            Cells(i, 2).Resize(LR2).Merge
            Cells(i, 2).VerticalAlignment = xlCenter
        End If
        i = i + LR2
    Loop
End Sub

 

[ndu96081631]

Thử:

Sub TH()
    Application.ScreenUpdating = False
    Call abc
    Call Merge_abc
    Application.ScreenUpdating = True
End Sub
Sub abc()
    Dim i, LR, Cll
    LR = Sheets(1).Cells(Rows.Count, 6).End(3).Rows
    i = 4
    [B4:B51].UnMerge
    On Error Resume Next
    With Sheets(1)
        For Each Cll In Sheets(2).Range("A2", Sheets(2).Cells(Rows.Count, 1).End(3))
            .Cells(i, 2) = Cll.Value
            i = i + 3
        Next
    End With
    With Sheets(1).Range("B4:B" & Range("f" & Rows.Count).End(3).Row)
        .SpecialCells(4).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
    For i = LR To 4
        If Cells(i, 2) = Cells(i - 1, 2) Then
            Range(Cells(i, 2), Cells(i - 1, 2)).Merge
        End If
    Next i
End Sub
Sub Merge_abc()
    Dim LR, LR2 As Long, i As Long
    LR = Cells(Rows.Count, "B").End(xlUp).Row
    i = 4
    Do While i < LR
        LR2 = 1
        Do While Cells(i, 2) = Cells(i + LR2, 2)
            LR2 = LR2 + 1
        Loop
        If LR2 > 1 Then
            Cells(i + 1, 2).Resize(LR2 - 1).ClearContents
            Cells(i, 2).Resize(LR2).Merge
            Cells(i, 2).VerticalAlignment = xlCenter
        End If
        i = i + LR2
    Loop
End Sub

Tôi thấy viết gọn thế vầy cũng được:

Sub Test()
  Dim rngMerge As Range, rngCopy As Range
  Dim idx As Long
  On Error Resume Next
  Set rngMerge = Sheet1.Range("B4").MergeArea
  Set rngCopy = Sheet2.Range("A2:A17")
  For idx = 1 To rngCopy.Count
     rngMerge.Value = rngCopy(idx).Value
     Set rngMerge = rngMerge.Offset(1)
  Next
End Sub

Đây là tính năng đặc biệt của Offset mà nếu không để ý sẽ bị sai nhưng nếu dùng có chủ đích thì bài này chính là nơi để Offset "thể hiện"

 

[giaiphap]

Tôi thấy viết gọn thế vầy cũng được:

Sub Test()
  Dim rngMerge As Range, rngCopy As Range
  Dim idx As Long
  On Error Resume Next
  Set rngMerge = Sheet1.Range("B4").MergeArea
  Set rngCopy = Sheet2.Range("A2:A17")
  For idx = 1 To rngCopy.Count
     rngMerge.Value = rngCopy(idx).Value
     Set rngMerge = rngMerge.Offset(1)
  Next
End Sub

Đây là tính năng đặc biệt của Offset mà nếu không để ý sẽ bị sai nhưng nếu dùng có chủ đích thì bài này chính là nơi để Offset "thể hiện"

Cách này hay quá anh!

 

[tran_hung]

Cám ơn các anh chị và thầy cô đã giúp đỡ, tạm thời mình sẽ lấy công thức của bạn congnt92 dùng, cám ơn bạn nhiều lắm. Còn đoạn mã thì nhờ phulien1902 và Mod ndu96081631 hướng dẫn chi tiết thêm về cách dùng được không? Vì mình từ trước đến giờ chỉ dùng hàm chứ chưa biết cách dùng mã code. Một lần nữa xin cám ơn tất cả đã quan tâm giúp đỡ, chúc mọi người sức khỏe và may mắn

 

[ndu96081631]

Còn đoạn mã thì nhờ phulien1902 và Mod ndu96081631 hướng dẫn chi tiết thêm về cách dùng được không? Vì mình từ trước đến giờ chỉ dùng hàm chứ chưa biết cách dùng mã code. Một lần nữa xin cám ơn tất cả đã quan tâm giúp đỡ, chúc mọi người sức khỏe và may mắn

Cách dùng code (chung chung cho bài này)
- Mở file Excel của bạn và bấm Alt + F11 để mở cửa sổ VBA
- Trong cửa sổ VBA, vào menu Insert, chọn Module để chèn 1 module
- Quay lại diễn đàn, copy code người ta viết sẵn rồi paste vào khung bên phải của Module đã chèn
- Bấm Alt + Q để thoát cửa sổ VBA, quay về bảng tính
- Bấm Alt + F8, cửa sổ Macro xuất hiện, chọn tên thủ tục rồi bấm Run
- Kiểm tra kết quả nhận được trên bảng tính

 

[tran_hung]

Cách dùng code (chung chung cho bài này)
- Mở file Excel của bạn và bấm Alt + F11 để mở cửa sổ VBA
- Trong cửa sổ VBA, vào menu Insert, chọn Module để chèn 1 module
- Quay lại diễn đàn, copy code người ta viết sẵn rồi paste vào khung bên phải của Module đã chèn
- Bấm Alt + Q để thoát cửa sổ VBA, quay về bảng tính
- Bấm Alt + F8, cửa sổ Macro xuất hiện, chọn tên thủ tục rồi bấm Run
- Kiểm tra kết quả nhận được trên bảng tính

Cám ơn Mod ndu96081631 nhiều lắm, mình sẽ thử, chúc Mod thật nhiều sức khỏe để hướng dẫn những mem như mình nhé. Thanks

 

[be_09]

Mình có file dữ liệu nguồn và file làm việc chứa công thức tính. Khi mình muốn copy file dữ liệu và dán file làm việc thì phải làm thủ công từng mã hàng vì file làm việc là file đã trộn 3 ô lại với nhau. Rất lâu và dễ sai, các anh chị và thầy cô có cách dán nào nhanh xin chỉ lại dùm. Chân thành cám ơn

Không biết bạn muốn làm cái gì? theo tôi thì làm thế này:
1/ Thiết kế 1 sheet Nhap_Lieu, dùng Advanced Filter lọc Item và gán dữ liệu vào mẫu.
2/ Sau khi bổ sung thông tin vào mẫu sau đó dùng mẫu này (vùng D1: N3), nhập liệu vào Sheet1 theo chiều dọc.

 

[tran_hung]

Không biết bạn muốn làm cái gì? theo tôi thì làm thế này:
1/ Thiết kế 1 sheet Nhap_Lieu, dùng Advanced Filter lọc Item và gán dữ liệu vào mẫu.
2/ Sau khi bổ sung thông tin vào mẫu sau đó dùng mẫu này (vùng D1: N3), nhập liệu vào Sheet1 theo chiều dọc.

View attachment 200531

Cám ơn be09 nhưng cách của bạn mình không áp dụng được do file nguồn từ sếp của mình đưa chỉ có 1 hàng thôi, mình muốn copy mã số vào file của mình đã trộn 3 ô lại với nhau. Còn cách của bạn là thiết kế 1 sheet thì không khả thi vì mã số nhiều lắm đến mấy trăm mã lận, không làm file như bạn hướng dẫn được. Dù sao cũng cám ơn bạn đã giúp đỡ

 

[be_09]

Cám ơn be09 nhưng cách của bạn mình không áp dụng được do file nguồn từ sếp của mình đưa chỉ có 1 hàng thôi, mình muốn copy mã số vào file của mình đã trộn 3 ô lại với nhau. Còn cách của bạn là thiết kế 1 sheet thì không khả thi vì mã số nhiều lắm đến mấy trăm mã lận, không làm file như bạn hướng dẫn được. Dù sao cũng cám ơn bạn đã giúp đỡ

Nếu file nguồn của sếp luôn cố định 17 dòng như vậy thì dùng Link là xong, mỗi lần thực hiện thì Copy nội dung của sếp vào Sheet2 thì nó tự động gán vào Sheet1 (theo mẫu của bạn), sau khi tính toán xong thì lưu tất cả nội dung của Sheet1 vào Sheet theo dõi.