Tự động xác định vùng nguồn cho Consolidate bằng cách nào?

Liên hệ QC
TrungChinhs

TrungChinhs

Thành viên tích cực
Tham gia
18/2/08
Bài viết
1,475
Được thích
2,468
Nghề nghiệp
Công chức
Chào các bạn !
từ sub
PHP: 
Sub Consolidate1()
    [G4].CurrentRegion.ClearContents
    [G4].Consolidate Sources:="R3C2:R30C5", Function:=xlSum, LeftColumn:=True
End Sub
Tôi muốn tự động xác định vùng nguồn cho Consolidate bằng phương thức CurrentRegion như đoạn code sau

PHP: 
Sub Consolidate2()
    [G4].CurrentRegion.ClearContents
    [G4].Consolidate Sources:= _
    [B4].CurrentRegion, Function:=xlSum, LeftColumn:=True
End Sub
nhưng code bị lỗi không chạy được (xem file đính kèm). Vậy phải sửa code này như thế nào ? nhờ các bạn chỉ bảo. Thank !
 

File đính kèm

  • NguonConsolidate.xls
    23.5 KB · Đọc: 109
Trung Chinh đã viết:
Chào các bạn !
từ sub
PHP: 
Sub Consolidate1()
    [G4].CurrentRegion.ClearContents
    [G4].Consolidate Sources:="R3C2:R30C5", Function:=xlSum, LeftColumn:=True
End Sub
Tôi muốn tự động xác định vùng nguồn cho Consolidate bằng phương thức CurrentRegion như đoạn code sau

PHP: 
Sub Consolidate2()
    [G4].CurrentRegion.ClearContents
    [G4].Consolidate Sources:= _
    [B4].CurrentRegion, Function:=xlSum, LeftColumn:=True
End Sub
nhưng code bị lỗi không chạy được (xem file đính kèm). Vậy phải sửa code này như thế nào ? nhờ các bạn chỉ bảo. Thank !
Nhấp chuột vào đây để mở rộng...
Anh sửa:
[B4].CurrentRegion, Function:=xlSum, LeftColumn:=True
thành:
[B4].CurrentRegion.Address(, , 2), Function:=xlSum, LeftColumn:=True
Vì địa chỉ vùng chọn trong code người ta quy định phải là TEXT, và được biểu diển dưới dạng R1C1
Ngoài ra anh có thể sửa code lại cho gọn, như vầy đây:
PHP: 
Sub Consolidate2()
    [G4].CurrentRegion.ClearContents
    [G4].Consolidate [B4].CurrentRegion.Address(, , 2), 9, 0, 1
End Sub
 
Lần chỉnh sửa cuối:
ndu96081631 đã viết:
Anh sửa:
[B4].CurrentRegion, Function:=xlSum, LeftColumn:=True
thành:
[B4].CurrentRegion.Address(, , 2), Function:=xlSum, LeftColumn:=True
Vì địa chỉ vùng chọn trong code người ta quy định phải là TEXT, và được biểu diển dưới dạng R1C1
Ngoài ra anh có thể sửa code lại cho gọn, như vầy đây:
PHP: 
Sub Consolidate2()
    [G4].CurrentRegion.ClearContents
    [G4].Consolidate [B4].CurrentRegion.Address(, , 2), 9, 0, 1
End Sub
Nhấp chuột vào đây để mở rộng...
loay hoay mãi timd chưa ra nhờ anh em hướng dẫn sửa đoạn màu đỏ thành CurrentRegion hoặc cách khác
.Range("B16").Consolidate Sources:=Array("'SHEET1'!R10C1:R500C17", "'SHEET2'!R10C1:R500C17", "'SHEET3'!R10C1:R500C17", "'SHEET4'!R10C1:R500C17"), Function:=xlSum , TopRow:=True, LeftColumn:=True, CreateLinks:=False
 
Lê Duy Thương đã viết:
loay hoay mãi timd chưa ra nhờ anh em hướng dẫn sửa đoạn màu đỏ thành CurrentRegion hoặc cách khác
.Range("B16").Consolidate Sources:=Array("'SHEET1'!R10C1:R500C17", "'SHEET2'!R10C1:R500C17", "'SHEET3'!R10C1:R500C17", "'SHEET4'!R10C1:R500C17"), Function:=xlSum , TopRow:=True, LeftColumn:=True, CreateLinks:=False
Nhấp chuột vào đây để mở rộng...

Viết vậy cũng được rồi, Thương còn muốn sửa sao nữa?
Con số 500 có thể sửa thành 1000 hay 10000 gì cũng được (dư chẳng sao cả)
 
ndu96081631 đã viết:
Viết vậy cũng được rồi, Thương còn muốn sửa sao nữa?
Con số 500 có thể sửa thành 1000 hay 10000 gì cũng được (dư chẳng sao cả)
Nhấp chuột vào đây để mở rộng...
vấn đề dư không sao . ý em muốn cái màu đỏ nó tự động khi thêm sheet hiện tại đang 4 sheet. nhưng lỡ thêm sheet 5 thì lại add tiếp mất công lắm. hì hì đang mò vờ bê a mà không ra
 
Lê Duy Thương đã viết:
vấn đề dư không sao . ý em muốn cái màu đỏ nó tự động khi thêm sheet hiện tại đang 4 sheet. nhưng lỡ thêm sheet 5 thì lại add tiếp mất công lắm. hì hì đang mò vờ bê a mà không ra
Nhấp chuột vào đây để mở rộng...

Ý Thương là Consolidate tất cả các sheet? Vậy cũng phải chừa ra 1 sheet nào đó chứ nhỉ?
Viết code tổng quát nhé: Chừa lại sheet nào thì Thương tự truyền tham số vào (nếu tên sheet cần chừa lại chưa tồn tại thì code sẽ tự Add)
Mã: 
Function SheetExists(ByVal wksName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(wksName) Is Nothing
End Function
Mã: 
Sub ConsolAllShs(ByVal SheetTarget As String, ByVal RangeTarget As String, ByVal Address_To_Consol As String)
  Dim aAddress, wksDes As Worksheet
  On Error Resume Next
  If Not SheetExists(SheetTarget) Then
    Set wksDes = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    wksDes.Name = SheetTarget
  Else
    Set wksDes = Worksheets(SheetTarget)
  End If
  aAddress = CollectAllAddress(SheetTarget, Address_To_Consol)
  wksDes.Range(RangeTarget).Resize(1, 1).Consolidate aAddress, 9, True, True
End Sub
Mã: 
Function CollectAllAddress(ByVal SheetTarget As String, ByVal Address_To_Consol As String)
  Dim Arr(), wks As Worksheet
  Dim n As Long
  For Each wks In Worksheets
    If UCase(wks.Name) <> UCase(SheetTarget) Then
      n = n + 1
      ReDim Preserve Arr(1 To n)
      Arr(n) = "'" & wks.Name & "'!" & Range(Address_To_Consol).Address(, , 2)
    End If
  Next
  If n Then CollectAllAddress = Arr
End Function
Mã: 
Sub Main()
  Dim Address_To_Consol As String, SheetTarget As String, RangeTarget As String
  Application.ScreenUpdating = False
  SheetTarget = "TONGHOP"
  RangeTarget = "B16"
  Address_To_Consol = "A10:Q1000"
  ConsolAllShs SheetTarget, RangeTarget, Address_To_Consol
  Application.ScreenUpdating = True
End Sub
Chạy Sub Main, truyền vào 3 thông số: Tên sheet đích, địa chỉ cell đích, Địa chỉ vùng dữ liệu cần Consoldate,
Vậy là xong
Như code của Sub Main ở trên thì:
- Tôi muốn sheet đích là "TONGHOP" (sheet này nếu chưa có thì code sẽ tự add vào)
- Đia chỉ vùng cần consolidate là "A10:Q1000"
- Kết quả đặt tại "B16" của sheet đích
- Tên các sheet con là cái gì mặc kệ nó (ta không quan tâm)
Chạy code thử xem ổn không?
-------------------
Mình nghĩ chổ mà Thương đang quan tâm chính là hàm CollectAllAddress
 

File đính kèm

  • Consolidate_MutiSheets_2.xlsm
    21.7 KB · Đọc: 68
Lần chỉnh sửa cuối:
ndu96081631 đã viết:
Ý Thương là Consolidate tất cả các sheet? Vậy cũng phải chừa ra 1 sheet nào đó chứ nhỉ?
Viết code tổng quát nhé: Chừa lại sheet nào thì Thương tự truyền tham số vào (nếu tên sheet cần chừa lại chưa tồn tại thì code sẽ tự Add)
Mã: 
Function SheetExists(ByVal wksName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(wksName) Is Nothing
End Function
Mã: 
Sub ConsolAllShs(ByVal SheetTarget As String, ByVal RangeTarget As String, ByVal Address_To_Consol As String)
  Dim aAddress, wksDes As Worksheet
  On Error Resume Next
  If Not SheetExists(SheetTarget) Then
    Set wksDes = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    wksDes.Name = SheetTarget
  Else
    Set wksDes = Worksheets(SheetTarget)
  End If
  aAddress = CollectAllAddress(SheetTarget, Address_To_Consol)
  wksDes.Range(RangeTarget).Resize(1, 1).Consolidate aAddress, 9, True, True
End Sub
Mã: 
Function CollectAllAddress(ByVal SheetTarget As String, ByVal Address_To_Consol As String)
  Dim Arr(), wks As Worksheet
  Dim n As Long
  For Each wks In Worksheets
    If UCase(wks.Name) <> UCase(SheetTarget) Then
      n = n + 1
      ReDim Preserve Arr(1 To n)
      Arr(n) = "'" & wks.Name & "'!" & Range(Address_To_Consol).Address(, , 2)
    End If
  Next
  If n Then CollectAllAddress = Arr
End Function
Mã: 
Sub Main()
  Dim Address_To_Consol As String, SheetTarget As String, RangeTarget As String
  Application.ScreenUpdating = False
  SheetTarget = "TONGHOP"
  RangeTarget = "B16"
  Address_To_Consol = "A10:Q1000"
  ConsolAllShs SheetTarget, RangeTarget, Address_To_Consol
  Application.ScreenUpdating = True
End Sub
Chạy Sub Main, truyền vào 3 thông số: Tên sheet đích, địa chỉ cell đích, Địa chỉ vùng dữ liệu cần Consoldate,
Vậy là xong
Như code của Sub Main ở trên thì:
- Tôi muốn sheet đích là "TONGHOP" (sheet này nếu chưa có thì code sẽ tự add vào)
- Đia chỉ vùng cần consolidate là "A10:Q1000"
- Kết quả đặt tại "B16" của sheet đích
- Tên các sheet con là cái gì mặc kệ nó (ta không quan tâm)
Chạy code thử xem ổn không?
-------------------
Mình nghĩ chổ mà Thương đang quan tâm chính là hàm CollectAllAddress
Nhấp chuột vào đây để mở rộng...
Càng mò mẫm thấy GPE bao nhiêu là cái hay.
Cảm ơn các anh chị, Code Consolidate rất chi là tuyệt.
Hàm CollectAllAddress:
Mã: 
Function CollectAllAddress(ByVal SheetTarget As String, ByVal Address_To_Consol As String)
  Dim Arr(), wks As Worksheet
  Dim n As Long
  For Each wks In Worksheets
    If UCase(wks.Name) <> UCase(SheetTarget) Then
      n = n + 1
      ReDim Preserve Arr(1 To n)
      Arr(n) = "'" & wks.Name & "'!" & Range(Address_To_Consol).Address(, , 2)
    End If
  Next
  If n Then CollectAllAddress = Arr
End Function
Theo em hiểu đó là lấy tên tất cả các sheet để tổng hợp.
Giờ file em có nhiều sheet, chỉ muốn lấy các sheet có tên dạng T1, T2, T3, T4... để tổng hợp thì Hàm trên cần thay đổi thế nào?
Em xin cảm ơn.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Lê Duy Thương đã viết:
loay hoay mãi timd chưa ra nhờ anh em hướng dẫn sửa đoạn màu đỏ thành CurrentRegion hoặc cách khác
.Range("B16").Consolidate Sources:=Array("'SHEET1'!R10C1:R500C17", "'SHEET2'!R10C1:R500C17", "'SHEET3'!R10C1:R500C17", "'SHEET4'!R10C1:R500C17"), Function:=xlSum , TopRow:=True, LeftColumn:=True, CreateLinks:=False
Nhấp chuột vào đây để mở rộng...
Dựa vào đoạn code này, e có thử viết thủ tục, thay bằng mã 9,1,1 như bài #2 thì báo lỗi "Expected Named Parameter"
Mã: 
Sub abc()
.Range("B16").Consolidate Sources:=Array("'SHEET1'!R10C1:R500C17", "'SHEET2'!R10C1:R500C17", "'SHEET3'!R10C1:R500C17", _
"'SHEET4'!R10C1:R500C17"), 9, 1, 1
End Sub
Vầy phải sửa sao?, hay chỉ có thể .........Function:=xlSum , TopRow:=True, LeftColumn:=True, CreateLinks:=False ???
 

File đính kèm

  • Expected Named Parameter.jpg
    Expected Named Parameter.jpg
    24.5 KB · Đọc: 53
Chỉnh sửa lần cuối bởi điều hành viên:
Có ai giải đáp giúp em bài #7 #8 không ạ.
Em xin cảm ơn!
 
Nhờ các anh (chị), các thầy giúp em một nội dung consolidate các file với ạ. Em có dùng record macro để làm thử thì đúng kết quả nhưng em không biết viết sao khi mình tổng hợp sẽ chọn đường dẫn đến các file sau đó từng sheet của từng file sẽ consolidate sum lại với nhau. Em có thử dùng code của các anh chị trên diễn đàn đàn nhưng không biết dùng, vì cứ mỗi sheet là có một vùng dữ liệu cần consolidate sum. Nhờ các anh chị, các thầy giúp em với. Em cảm ơn ạ.
 

File đính kèm

  • Thu nghiem.rar
    70.3 KB · Đọc: 3
ndu96081631 đã viết:
Ý Thương là Consolidate tất cả các sheet? Vậy cũng phải chừa ra 1 sheet nào đó chứ nhỉ?
Viết code tổng quát nhé: Chừa lại sheet nào thì Thương tự truyền tham số vào (nếu tên sheet cần chừa lại chưa tồn tại thì code sẽ tự Add)
Mã: 
Function SheetExists(ByVal wksName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(wksName) Is Nothing
End Function
Mã: 
Sub ConsolAllShs(ByVal SheetTarget As String, ByVal RangeTarget As String, ByVal Address_To_Consol As String)
  Dim aAddress, wksDes As Worksheet
  On Error Resume Next
  If Not SheetExists(SheetTarget) Then
    Set wksDes = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    wksDes.Name = SheetTarget
  Else
    Set wksDes = Worksheets(SheetTarget)
  End If
  aAddress = CollectAllAddress(SheetTarget, Address_To_Consol)
  wksDes.Range(RangeTarget).Resize(1, 1).Consolidate aAddress, 9, True, True
End Sub
Mã: 
Function CollectAllAddress(ByVal SheetTarget As String, ByVal Address_To_Consol As String)
  Dim Arr(), wks As Worksheet
  Dim n As Long
  For Each wks In Worksheets
    If UCase(wks.Name) <> UCase(SheetTarget) Then
      n = n + 1
      ReDim Preserve Arr(1 To n)
      Arr(n) = "'" & wks.Name & "'!" & Range(Address_To_Consol).Address(, , 2)
    End If
  Next
  If n Then CollectAllAddress = Arr
End Function
Mã: 
Sub Main()
  Dim Address_To_Consol As String, SheetTarget As String, RangeTarget As String
  Application.ScreenUpdating = False
  SheetTarget = "TONGHOP"
  RangeTarget = "B16"
  Address_To_Consol = "A10:Q1000"
  ConsolAllShs SheetTarget, RangeTarget, Address_To_Consol
  Application.ScreenUpdating = True
End Sub
Chạy Sub Main, truyền vào 3 thông số: Tên sheet đích, địa chỉ cell đích, Địa chỉ vùng dữ liệu cần Consoldate,
Vậy là xong
Như code của Sub Main ở trên thì:
- Tôi muốn sheet đích là "TONGHOP" (sheet này nếu chưa có thì code sẽ tự add vào)
- Đia chỉ vùng cần consolidate là "A10:Q1000"
- Kết quả đặt tại "B16" của sheet đích
- Tên các sheet con là cái gì mặc kệ nó (ta không quan tâm)
Chạy code thử xem ổn không?
-------------------
Mình nghĩ chổ mà Thương đang quan tâm chính là hàm CollectAllAddress
Nhấp chuột vào đây để mở rộng...
Anh @ndu96081631 cho em Vân hỏi với ! Với trường hợp này có cách thức nào tùy chỉnh điều kiện cột điều kiện cộng tổng không ạ ?
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

8
  • Question
Xin giúp: Nhóm (group data) các dòng trong bảng tính
Trả lời
10
Đọc
342
DeTong
D
pupuchcha
  • Question
Viết code để tìm xích ma, mong mọi người giúp đỡ em ạ
Trả lời
6
Đọc
193
VetMini
V
longhungvnpost
kết hợp hàm vlookup và hlookup như thế nào, giúp e với
Trả lời
4
Đọc
57
longhungvnpost
longhungvnpost
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
29
Đọc
498
Emyeuexcel
Emyeuexcel
TrinhThiHai_Kt
  • Dán lên cao
Các câu hỏi về sử dụng diễn đàn
5 6 7
Trả lời
122
Đọc
185K
Hai Lúa Miền Tây
Hai Lúa Miền Tây
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom