Kết hợp nhiều sheet vào sheet tổng hợp

[ALOAN]

- Từ bảng "TONGHOP", em tạo thành nhiều sheet, mỗi sheet là tên của nhười đảm nhiệm.
-Em share file này cho mọi người cùng cập nhật.
- Mọi người giúp em viết code để sau khi người đảm nhiệm cập nhật xong, code có thể giúp tổng hợp nhanh các sheet này vào sheet "TONGHOP" (như vd).
Cảm ơn mọi người nhiều.

 

[nhatthai]

Theo tôi, nếu cac sheet cùng cấu trúc thì bạn có thể sử dụng LỆNH Consolidate... trong menu Data

 

[ALOAN]

Mình đã thử rồi nhưng không được.
Bạn tạo file mẫu giúp mình được ko?

Em có suy nghĩ như sau:
-Tạo 1 mãng là vùng cần điền dữ liệu (C7:K40)
- Mỗi phần tử trong mãng như là 1 biến tạm.
-If tên sheet khác "TONGHOP"
+ nếu giá trị trong sheet này khác rỗng thì được kết hợp với giá trị trước trong mảng và sau đó gán vào mãng ở vị trí tương ứng.
Không biết trong VBA có thể làm được như vậy không?
Mong mọi người chỉ giúp

 

[SA_DQ]

Hãy xem tạm, chưa tô màu như í tác giả được

Option Explicit:                    Dim jJ As Long

Sub Summary()
 Dim lRow As Long:                  Dim Clls As Range
 
 Application.ScreenUpdating = False
 lRow = Sheets("TgHop").[b65432].End(xlUp).Row
 Sheets("TgHop").Range("C7:L" & lRow + 9).Clear
 For jJ = 7 To lRow
   Sheets("Q").Select
   With Cells(jJ, 3)
      If .Value <> "" Then
         .Resize(1, 9).Copy Destination:=Sheets("TgHop").Cells(jJ, 3)
      End If
   End With
   ConLai 2:                              ConLai 3
 Next jJ
 
 Sheets("TgHop").Select
 For Each Clls In Range("C7:K" & lRow)
   With Clls
      .Value = Replace(.Value, Chr(10) & Chr(10), "")
   End With
 Next Clls
 
End Sub

'   *     *              *     *              *     *              *     *               '

Sub ConLai(Sht As Byte)
 Dim bW As Byte, StrC As String
 
 StrC = IIf(Sht = 2, "Th", "H"):            Sheets(StrC).Select
 With Cells(jJ, 3)
   If .Value <> "" Then
      If Sheets("TgHop").Cells(jJ, 3) = "" Then
         .Resize(1, 9).Copy Destination:=Sheets("TgHop").Cells(jJ, 3)
         Sheets("TgHop").Cells(jJ, 3).Resize(1, 9).Font.ColorIndex = _
            IIf(Sht = 2, 5, 3)
      Else
         For bW = 3 To 11
            If Cells(jJ, bW) <> "" And Sheets("TgHop").Cells(jJ, bW) <> "" Then
               Sheets("TgHop").Cells(jJ, bW) = Sheets("TgHop").Cells(jJ, bW) _
                  & Chr(10) & Cells(jJ, bW)
            ElseIf Cells(jJ, bW) <> "" And Sheets("TgHop").Cells(jJ, bW) = "" Then
               Sheets("TgHop").Cells(jJ, bW) = Cells(jJ, bW)
            End If
         Next bW
   End If:                 End If
 End With
End Sub

                   [B][I][COLOR="Purple"] [SIZE="2"]Xem thêm trong file đính kèm & chúc vui![/SIZE]
 [/COLOR][/I][/B]                              [COLOR="LightBlue"][SIZE="3"](Nếu vẫn muốn tô màu thì sẽ cố tiếp!)[/SIZE][/COLOR]

 

[SA_DQ]

VER 2.01 đây, mại zô

Option Explicit:                    Dim jJ As Long

[B]Sub Summary()[/B]
 Dim lRow As Long:                  Dim Clls As Range
 
 Application.ScreenUpdating = False
 lRow = Sheets("TgHop").[b65432].End(xlUp).Row
 Sheets("TgHop").Range("C7:L" & lRow + 9).Clear
 For jJ = 7 To lRow
   ConLai 1
   ConLai 2:                              ConLai 3
 Next jJ
 
 Sheets("TgHop").Select
 For Each Clls In Range("C7:K" & lRow)
   With Clls
      .Value = Replace(.Value, Chr(10) & Chr(10), "")
   End With
 Next Clls
[B]End Sub[/B]

Sub ConLai(Sht As Byte)
 Dim bW As Byte, StrC As String
 
 StrC = Choose(Sht, "Qn", "Th", "Hh")
 Sheets(StrC).Select
 With Cells(jJ, 3)
   If .Value <> "" Then
      
      If Sht = 1 Then
         .Resize(1, 9).Copy Destination:=Sheets("TgHop").Cells(jJ, 3)
         Exit Sub
      End If
      
      If Sheets("TgHop").Cells(jJ, 3) = "" Then
         .Resize(1, 9).Copy Destination:=Sheets("TgHop").Cells(jJ, 3)
         Sheets("TgHop").Cells(jJ, 3).Resize(1, 9).Font.ColorIndex = _
            IIf(Sht = 2, 5, 3)
      Else
         For bW = 3 To 11
            If Cells(jJ, bW) <> "" And Sheets("TgHop").Cells(jJ, bW) <> "" Then
               Sheets("TgHop").Cells(jJ, bW) = Sheets("TgHop").Cells(jJ, bW) _
                  & Chr(10) & Cells(jJ, bW)
            ElseIf Cells(jJ, bW) <> "" And Sheets("TgHop").Cells(jJ, bW) = "" Then
               Sheets("TgHop").Cells(jJ, bW) = Cells(jJ, bW)
            End If
         Next bW
   End If:                 End If
 End With
End Sub

 

[ALOAN]

Cảm ơn Bác Sa nhiều nha:Code của Bác viết hay lắm, trong đó em tâm đắc nhất là cách dùng:

For jJ = 7 To lRow
ConLai 1 ConLai 2: ConLai 3
Next jJ

Nhờ phần hướng dẫn của Bác, E cũng tạo cho mình được 1 code như bên dưới. Bác xem và cho em lời khuyên nha!

Option Explicit
Sub Summary()
Dim iR As Byte, iC As Byte, iSh As Byte, Er As Byte, Ec As Byte, Sh As Byte
Dim A()
Dim Rgn As Range
With Sheets("TgHop")
Er = Range("B6").End(xlDown).Row
Ec = Range("B6").End(xlToRight).Column
End With
Sheets("TgHop").Range(Cells(7, 3), Cells(Er, Ec)).Clear
Sh = Sheets.Count
For iSh = 1 To Sh
   If Sheets(iSh).Name <> "TgHop" Then
      Sheets(iSh).Select
               For iR = 7 To Er
                     For iC = 3 To Ec
                     If Cells(iR, iC).Value <> "" Then
                     Sheets("TgHop").Cells(iR, iC) = Sheets("TgHop").Cells(iR, iC) _
                            & Chr(10) & Cells(iR, iC)
                     End If
                    Next iC
              Next iR
    End If
Next iSh
        Sheets("TgHop").Select
End Sub

Thanks

 

[Phanhanhdai]

Ý nghĩa của Resize và Target

Mình chưa hiểu Resize và Target có nghĩa là gì. Các bạn có thể giải thích cho mình được không?

 

[ndu96081631]

Target: Chính là cell mà bạn đang chọn (thường nằm trong sự kiện Change hoặc SelectionChange)... Khi bạn thay đổi cell chọn, hoặc thay đổi số liệu trên 1 cell thì cell ấy chính là Target
Resize: Chỉnh lại vùng Range, cái này gần giống với hàm OFFSET của công thức Excel

 

[SA_DQ]

Riệng Resize thì không phải vậy đâu, NDU à!

Target: Chính là cell mà bạn đang chọn (thường nằm trong sự kiện Change hoặc SelectionChange)... Khi bạn thay đổi cell chọn, hoặc thay đổi số liệu trên 1 cell thì cell ấy chính là Target
Resize: Chỉnh lại vùng Range, cái này gần giống với hàm OFFSET của công thức Excel

Nếu ta đang kích hoạt B1
Khi viết dòng lệnh

 With [B1]
       MsgBox .Offset(1, 2).Address , , "A"
       MsgBox .Resize(1, 2)..Address , , "B"
 End With

Hộp thoại 'B' sẽ là $B$1:$C$1 kia đó!
(Số dòng & số cột được mở rọng thêm!)

Nếu có thời gian bạn bấm vô mấy chữ này trong phần chữ ký của mình & nghiền ngẫm thêm cho zui!

Chúc vui nha!

 

[ndu96081631]

Em nói "gần giống" thôi...
Trong VBA: Resize + Offset nữa mới hoàn toàn giống với hàm OFFSET
Vì OFFSET trong công thức Excel vừa dịch chuyển vùng lại thay đổi size của vùng luôn

 

[SA_DQ]

Cảm ơn Bác Sa nhiều nha:Code của Bác viết hay lắm, trong đó em tâm đắc nhất là cách dùng:

Nhờ phần hướng dẫn của Bác, E cũng tạo cho mình được 1 code như bên dưới. Bác xem và cho em lời khuyên nha!

Quá chuẩn luôn!

Chỉ còn góp chổ này tẹo thôi:

 '. . . . '
 With Sheets("TgHop")
      Er = Range("B6").End(xlDown).Row
      Ec = Range("B6").End(xlToRight).Column
 End With
 Sheets("TgHop").Range(Cells(7, 3), Cells(Er, Ec)).Clear

Nên là trong 2 trường hợp sau:
1/*

'. . . . '
 With Sheets("TgHop").Range("B6")
      Er = .End(xlDown).Row
      Ec = .End(xlToRight).Column
 End With
 Sheets("TgHop").Range(Cells(7, 3), Cells(Er, Ec)).Clear

2/*

'. . . . '
 With Sheets("TgHop")
      Er = Range("B6").End(xlDown).Row
      Ec = Range("B6").End(xlToRight).Column
      .Range(Cells(7, 3), Cells(Er, Ec)).Clear
 End With

Ý nghĩa của nó là vầy:
VD tòa nhà của bạn gồm 256 tầng lầu & mỗi lầu là 65000 phòng
Viết như bạn sẽ được diễn giải như sau:

Đến tòa nhà của tôi
lên lầu 1 phòng thứ sáu & đo kích thước cuôi phòng (C1)
(lại xuống lầu đến tòa nhà của tôi), lên lầu 1 phòng thứ sáu & đo kích thước cạnh phải của phòng (C2)
Còn ờ (1):
Đến nhà của tôi, lên lầu 1 phòng thứ sáu
đo kích thước cuôi phòng (C1)
đo kích thước cạnh phải của phòng (C2)