Tự động xác định vùng nguồn cho Consolidate bằng cách nào? (2 người xem)

TrungChinhs · 21/3/09

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 !

ndu96081631 · 21/3/09

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 !

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ê Duy Thương · 15/7/13

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

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

ndu96081631 · 15/7/13

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

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ả)

Lê Duy Thương · 15/7/13

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ả)

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

ndu96081631 · 15/7/13

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

Ý 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

huy vu · 19/12/14

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

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.

huy vu · 19/12/14

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

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 ???

huy vu · 22/12/14

Có ai giải đáp giúp em bài #7 #8 không ạ.
Em xin cảm ơn!

Quang_Hải · 23/12/14

Huy Vũ đã viết:
Có ai giải đáp giúp em bài #7 #8 không ạ.
Em xin cảm ơn!

Bài 7 thì phải viết thế này
If UCase(wks.Name) Like "T" &"*" Then

Bài 8 lỗi là chắc do cái dấu chấm thừa ở trước chữ Range

......

VetMini · 23/12/14

quanghai1969 đã viết:
...
If UCase(wks.Name) Like "T" &"*" Then
...

Chỉ có 1 ký tự thì đâu có cần UCase

If wks.Name Like "[tT]*" Then ...

namkpac · 3/12/19

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 ạ.

vanaccex · 19/2/20

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

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 ạ ?

ndu96081631 · 19/2/20

vanaccex đã viết:
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 ạ ?

Tức là điều kiện gì bạn?

vanaccex · 19/2/20

ndu96081631 đã viết:
Tức là điều kiện gì bạn?

Dạ ví dụ em Vân muốn có thể xác định được điều kiện tính tổng là tùy chọn ạ có thể là nhiều cột cách nhau giả sử như a, c, e ạ

Em Vân rất mong anh @ndu96081631 update hàm này ạ

Em Vân cảm ơn anh nhiều ạ !!!

Tự động xác định vùng nguồn cho Consolidate bằng cách nào? (2 người xem)

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

TrungChinhs

Thành viên tích cực

File đính kèm

ndu96081631

Huyền thoại GPE

Lê Duy Thương

Cạo lấy gì gội (Dịch quá không gội được)

ndu96081631

Huyền thoại GPE

Lê Duy Thương

Cạo lấy gì gội (Dịch quá không gội được)

ndu96081631

Huyền thoại GPE

File đính kèm

huy vu

Thành viên hoạt động

huy vu

Thành viên hoạt động

File đính kèm

huy vu

Thành viên hoạt động

Quang_Hải

Thành viên gạo cội

VetMini

Ăn cùng góc phố

namkpac

Thành viên thường trực

File đính kèm

vanaccex

Thành viên tiêu biểu

ndu96081631

Huyền thoại GPE

vanaccex

Thành viên tiêu biểu

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

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

Đếm ngược thời gian