Bạn giải thích giúp mình cái coi:
Sao '1x4600' không ở ô [H13] mà lại ở [I13] vậy?
Độ dài của các đoạn trong 1 thanh được chia như thế nào vậy bạn? Có quy luật gì không?Nhờ các bạn giúp mình đoạn code với chức năng diễn giải chi tiết các thanh từ bảng số liệu đã có.
Mình có trình bày chi tiết ở file đính kèm để các bạn dễ nắm ý.
Nhờ các bạn giúp cho, mình cảm ơn!
Fân bố đều đó chú mày! Nhưng mình chỉ làm tương đối thôi, chưa như những gì tác giả đã vẽ ra;Độ dài của các đoạn trong 1 thanh được chia như thế nào vậy bạn? Có quy luật gì không?
P/S: Cái bảng dữ liệu nhìn quen quen.
Độ dài của các đoạn trong 1 thanh được chia như thế nào vậy bạn? Có quy luật gì không?
P/S: Cái bảng dữ liệu nhìn quen quen.
Fân bố đều đó chú mày! Nhưng mình chỉ làm tương đối thôi, chưa như những gì tác giả đã vẽ ra;
Gởi tác gia: Bạn thử tăng số hàng lên xem;
Sao đó thử tăng số liệu cột; Nhưng từ từ 1 vài cột thôi nhé! Hàng mỏng & dễ vỡ mà lị!
Để tiện hơn cho việc phân chia trên thanh, mình nghĩ nên tạo thêm 1 sheet dữ liệu thanh mẫu đã được chia sẵn, sau đó code sẽ tìm thanh phù hợp và copy qua.
Nhờ các bạn xem như vậy có dễ code hơn không?
Cái khó là cột dữ liệu có thể tăng giảm; Khi đó có thể đổi cột trị màu vàng lên đầu còn các cột số liệu fía sau nó/chúng là cách đều 1 khoảng trống; Bạn chịu vậy không?
[COLOR=#d3d3d3]cột: AA [/COLOR]| [COLOR=#d3d3d3]AB[/COLOR] | [COLOR=#d3d3d3]AC[/COLOR] | . . .
[COLOR=#d3d3d3]D13[/COLOR] [COLOR=#ff8c00][B]150[/B] [/COLOR]| |4600x1 |
[COLOR=#d3d3d3]D17[/COLOR] [COLOR=#ff8c00][B]1050[/B][/COLOR] | | 4600x2|
Bắt đầu từ cột [A] trở đi & dòng 13 trở xuống dưới
Khi đó cột số tại [AA] chứa trị thuộc dòng 2 của CSDLMã:[COLOR=#d3d3d3]cột: AA [/COLOR]| [COLOR=#d3d3d3]AB[/COLOR] | [COLOR=#d3d3d3]AC[/COLOR] | . . . [COLOR=#d3d3d3]D13[/COLOR] [COLOR=#ff8c00][B]150[/B] [/COLOR]| |4600x1 | [COLOR=#d3d3d3]D17[/COLOR] [COLOR=#ff8c00][B]1050[/B][/COLOR] | | 4600x2|
Nhờ các bạn giúp mình đoạn code với chức năng diễn giải chi tiết các thanh từ bảng số liệu đã có.
Mình có trình bày chi tiết ở file đính kèm để các bạn dễ nắm ý.
Nhờ các bạn giúp cho, mình cảm ơn!
Bạn thử file này. Chia theo tỷ lệ luôn.
Đừng đòi thêm Hai Bà Trưng nhé.Thật tuyệt vời!
Bạn có thể giúp mình thay vì đứng tại sheet vẽ (sheet 2) thì ta đứng tại sheet dữ liệu (sheet 1), và khi chạy code mới tạo ra sheet vẽ và vẽ được không?
Mình cảm ơn!
Đừng đòi thêm Hai Bà Trưng nhé.
Tôi viết để có thể sử dụng được trên Excel 2003 (256 cột) nên số thanh tối đa là 254. Nếu muốn nhiều hơn thì bạn sửa IV1 trong code thành XFD1, số thanh tối đa sẽ là 16382.Sẽ không có Bà Trưng nữa, mới tải nhưng cũng rất cảm ơn!
Chúc bạn và GPE may mắn nhé!
Ah, bạn cho mình hỏi với code này thì có thể vẽ nhiều nhất bao nhiêu thanh vậy?
mình thử với >700 thanh thì ko vẽ được.
Tôi viết để có thể sử dụng được trên Excel 2003 (256 cột) nên số thanh tối đa là 254. Nếu muốn nhiều hơn thì bạn sửa IV1 trong code thành XFD1, số thanh tối đa sẽ là 16382.
Lưu ý: Sửa xong nếu chạy trên Excel 2003 sẽ bị lỗi.
DuLieu = Range([COLOR=#ff0000]Sheet1[/COLOR].[SH1].End(xlToLeft).Offset(1), [COLOR=#ff0000]Sheet1[/COLOR].[A65536].End(xlUp)).Value
Mình cảm ơn!
Mã:DuLieu = Range([COLOR=#ff0000]Sheet1[/COLOR].[SH1].End(xlToLeft).Offset(1), [COLOR=#ff0000]Sheet1[/COLOR].[A65536].End(xlUp)).Value
Muốn với một tên sheet bất kỳ chứ không phải giới hạn trong 'Sheet1' thì thay sheet1 ở đoạn code trên bằng gì vậy bạn?
Nhiều lúc làm trên nhiều sheet với nhiều tên khác nhau sẽ bị lỗi.
p/s: Đã hứa không bà trưng nữa mà giờ ... ngại quá
Sub VeHinh()
Application.ScreenUpdating = False
Dim Sh As Worksheet, DaiThanh As Double, DuLieu, i As Long, j As Long, Thanh, DaiiThanh As Long, STTDoan As Long, Doan As Long
DuLieu = Range(ActiveSheet.[XFD1].End(xlToLeft).Offset(1), ActiveSheet.[A65536].End(xlUp)).Value
Set Sh = Sheets.Add
Sh.Columns("B:CW").ColumnWidth = 0.65
For i = 2 To UBound(DuLieu, 2)
ReDim Thanh(1 To 3, 1 To 1)
Doan = 0
DaiThanh = DuLieu(1, i)
DaiiThanh = 0
STTDoan = 0
For j = 2 To UBound(DuLieu, 1)
DaiThanh = DaiThanh + DuLieu(j, 1) * DuLieu(j, i)
Next
DaiThanh = DaiThanh / 100
For j = 2 To UBound(DuLieu, 1)
If DuLieu(j, i) <> 0 Then
Doan = Doan + 1
ReDim Preserve Thanh(1 To 3, 1 To Doan)
Thanh(1, Doan) = DuLieu(j, i) & "x" & DuLieu(j, 1)
Thanh(2, Doan) = DuLieu(j, i) * DuLieu(j, 1) / DaiThanh
Thanh(3, Doan) = Application.WorksheetFunction.Max(1, Round(Thanh(2, Doan), 0))
DaiiThanh = DaiiThanh + Thanh(3, Doan)
End If
Next
If DuLieu(1, i) <> 0 Then
Doan = Doan + 1
ReDim Preserve Thanh(1 To 3, 1 To Doan)
Thanh(1, Doan) = DuLieu(1, i)
Thanh(2, Doan) = DuLieu(1, i) / DaiThanh
Thanh(3, Doan) = Application.WorksheetFunction.Max(1, Round(Thanh(2, Doan), 0))
DaiiThanh = DaiiThanh + Thanh(3, Doan)
End If
Do Until DaiiThanh = 100 Or STTDoan = UBound(Thanh, 2)
STTDoan = STTDoan + 1
If DaiiThanh < 100 Then
If Thanh(2, STTDoan) > Thanh(3, STTDoan) Then
Thanh(3, STTDoan) = Thanh(3, STTDoan) + 1
DaiiThanh = DaiiThanh + 1
End If
ElseIf DaiiThanh > 100 Then
If Thanh(3, STTDoan) > 1 Then
If Thanh(2, STTDoan) < Thanh(3, STTDoan) Then
Thanh(3, STTDoan) = Thanh(3, STTDoan) - 1
DaiiThanh = DaiiThanh - 1
End If
End If
End If
Loop
Do
For STTDoan = 1 To UBound(Thanh, 2)
If DaiiThanh = 100 Then Exit Do
If Thanh(3, STTDoan) > 1 Then
Thanh(3, STTDoan) = Thanh(3, STTDoan) - 1
DaiiThanh = DaiiThanh - 1
End If
Next
Loop
Sh.Cells(i * 4 - 6, 1).Resize(2).RowHeight = 6.5
DaiiThanh = 1
With Sh.Cells(i * 4 - 7, 1)
.Value = "'" & (i - 1)
With .Resize(4)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
With Sh.Cells(i * 4 - 6, 2)
.Resize(2).Borders(xlEdgeLeft).LineStyle = xlContinuous
With .Resize(, 100)
.Borders(xlBottom).LineStyle = xlContinuous
.Offset(-1).HorizontalAlignment = xlCenterAcrossSelection
End With
End With
For j = 1 To UBound(Thanh, 2)
Sh.Cells(i * 4 - 7, DaiiThanh + 1).Value = "'" & Thanh(1, j)
DaiiThanh = DaiiThanh + Thanh(3, j)
Sh.Cells(i * 4 - 6, DaiiThanh).Resize(2).Borders(xlEdgeRight).LineStyle = xlContinuous
Next
If DuLieu(1, i) <> 0 Then Sh.Cells(i * 4 - 6, DaiiThanh - Thanh(3, UBound(Thanh, 2)) + 1).Resize(2, Thanh(3, UBound(Thanh, 2))).Interior.ColorIndex = 6
Next
Application.ScreenUpdating = True
End Sub