VBA - Histogram

[hoahuongduong1986]

Kính gửi A Chị và các Bạn,
Em muốn dùng Data Analysis trong thẻ Data để phân tích nhóm các đối tượng như ví dụ kèm File. Tại sheet Histogram, Cột A là mã khách hàng, cột B là số tiền (Histogram sẽ tìm ra có bao nhiêu khách hàng có số tiền trong các khoảng cố định của vùng E7:E10). Có thể dùng VBA để lập lại quy trình này được không ạ (Vào Data => Chọn Data analysis => Chọn Histogram => Rồi chọn vùng đầu vào là vùng B4: Bx, Bin Range là cố định E7:E10, đầu ra tại vùng cố định là I4). Em cảm ơn anh chị ạ.

 

[HieuCD]

Kính gửi A Chị và các Bạn,
Em muốn dùng Data Analysis trong thẻ Data để phân tích nhóm các đối tượng như ví dụ kèm File. Tại sheet Histogram, Cột A là mã khách hàng, cột B là số tiền (Histogram sẽ tìm ra có bao nhiêu khách hàng có số tiền trong các khoảng cố định của vùng E7:E10). Có thể dùng VBA để lập lại quy trình này được không ạ (Vào Data => Chọn Data analysis => Chọn Histogram => Rồi chọn vùng đầu vào là vùng B4: Bx, Bin Range là cố định E7:E10, đầu ra tại vùng cố định là I4). Em cảm ơn anh chị ạ.

Thử code

Sub Macro1()
  Application.Run "ATPVBAEN.XLAM!Histogram", Range("B4", Range("B65000").End(xlUp)), [j4], [e7:e10], False, True, True, False
End Sub

 

[Ashiya199]

Thử code

Sub Macro1()
  Application.Run "ATPVBAEN.XLAM!Histogram", Range("B4", Range("B65000").End(xlUp)), [j4], [e7:e10], False, True, True, False
End Sub

Chào bác @HieuCD

Em cũng đang tạo record macro Histogram. Khi chạy lại macro thì báo lỗi
Giống như bài viết dưới đây.

Lỗi application run 1004

Em mới tìm hiểu về Visual Basic để nộp bài tập lớn có download một ví dụ về bài tập trên mạng. Nhưng khi chạy hiện ra thông báo lỗi Khi chọn debug nó trỏ đến dòng Application.Run "ATPVBAEN.XLA!Histogram", Worksheets("SimRuns").Range("SimResults"), _...

www.giaiphapexcel.com

Em đã vào tool reference tìm analysis toolpack nhưng không thấy có.
Bác có thể chỉ giáo giúp em fix lỗi được không

Thanks bác nhiều~~~

 

[HieuCD]

Chào bác @HieuCD

Em cũng đang tạo record macro Histogram. Khi chạy lại macro thì báo lỗi View attachment 246280
Giống như bài viết dưới đây.

Lỗi application run 1004

Em mới tìm hiểu về Visual Basic để nộp bài tập lớn có download một ví dụ về bài tập trên mạng. Nhưng khi chạy hiện ra thông báo lỗi Khi chọn debug nó trỏ đến dòng Application.Run "ATPVBAEN.XLA!Histogram", Worksheets("SimRuns").Range("SimResults"), _...

www.giaiphapexcel.com

Em đã vào tool reference tìm analysis toolpack nhưng không thấy có.
Bác có thể chỉ giáo giúp em fix lỗi được không

Thanks bác nhiều~~~

Bạn vào option add ins, add 2 add in

 

[Ashiya199]

Bạn vào option add ins, add 2 add in
View attachment 246282

Thanks bác rất nhiều.
Thì ra là để chạy được VBA thì phải add in cả cai Analysis ToolPak- VBA.
Mặc dù em chưa hiểu về add in (em đang học hỏi dần)

 

[hoahuongduong1986]

Thử code

Sub Macro1()
  Application.Run "ATPVBAEN.XLAM!Histogram", Range("B4", Range("B65000").End(xlUp)), [j4], [e7:e10], False, True, True, False
End Sub

Cho em hỏi thêm anh, là giờ muốn thêm một cột dư nợ theo từng mức thì làm thế nào ạ (Sum of AMOUNT_DISBURSED)

Bin	Frequency	Cumulative %	Sum of AMOUNT_DISBURSED​
500,000,000​	28​	43.08%​
1,000,000,000​	23​	78.46%​
2,000,000,000​	6​	87.69%​
3,000,000,000​	6​	96.92%​
More​	2​	100.00%​

 

[HieuCD]

Cho em hỏi thêm anh, là giờ muốn thêm một cột dư nợ theo từng mức thì làm thế nào ạ (Sum of AMOUNT_DISBURSED)

Bin	Frequency	Cumulative %	Sum of AMOUNT_DISBURSED​
500,000,000​	28​	43.08%​
1,000,000,000​	23​	78.46%​
2,000,000,000​	6​	87.69%​
3,000,000,000​	6​	96.92%​
More​	2​	100.00%​

Chạy code

Sub Macro1()
  Dim Data As Range, Bin As Range, OutPut As Range, Res(), sRow&, N&, i&, r&
 
  Set Data = Range("B4", Range("B65000").End(xlUp))
  Set Bin = Range("E7:E10")
  Set OutPut = Range("J4")
  Application.Run "ATPVBAEN.XLAM!Histogram", Data, OutPut, Bin, False, True, True, False
  Range("M4").Value = Range("B3").Value
 
  N = Bin.Rows.Count
  sRow = Data.Rows.Count
  ReDim Res(1 To N + 1, 1 To 1)
  For i = 1 To sRow
    tmp = Data(i, 1)
    For r = 1 To N
      If tmp <= Bin(r, 1) Then
        Res(r, 1) = Res(r, 1) + tmp
        Exit For
      End If
    Next r
    If r = N + 1 Then Res(r, 1) = Res(r, 1) + tmp
  Next i
  Range("M5").Resize(N + 1) = Res
End Sub