Sửa code để hoàn thiện file thống kê thép. (1 người xem)

nguyenkhoadng · 29/11/12

Mã:

Public bienkhoa As IntegerSub KHOA()
Dim cotc As Single
cotc = ActiveCell.Column
bienkhoa = 1
If cotc <> 3 Then
    MsgBox "Ban chon vi tri cot chua dung. Chon lai vi tri cot C va tiep tuc cong viec", vbOKOnly, "THÔNG BÁO"
    Exit Sub
Else
bienkhoa = 0
     i = ActiveCell.Row
     Cells(i, "A").Select
    Sheets("DuLieu").Range("A16:Q16").Copy
    ActiveCell.Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
End If


End Sub

Với đoạn code trên khi mình thực hiện 1 macro thì ở vị trí ô nào nó cũng hiện thông báo, kể cả mình đặt tại vị trí cột C.
Nhờ các bạn sửa giúp để chỉ thông báo khi mình đặt vị trí làm việc ngoài cột C thôi, còn nếu trong cột C thì thực hiện lệnh copy.
Mình cảm ơn trước!

Quang_Hải · 29/11/12

nguyenkhoadng đã viết:
Mã:

Public bienkhoa As IntegerSub KHOA() [COLOR=#ff0000]Dim cotc As Single[/COLOR] cotc = ActiveCell.Column bienkhoa = 1 If cotc <> 3 Then MsgBox "Ban chon vi tri cot chua dung. Chon lai vi tri cot C va tiep tuc cong viec", vbOKOnly, "THÔNG BÁO" Exit Sub Else bienkhoa = 0 i = ActiveCell.Row Cells(i, "A").Select Sheets("DuLieu").Range("A16:Q16").Copy ActiveCell.Select ActiveSheet.Paste ActiveCell.Offset(0, 3).Select End If End Sub

Với đoạn code trên khi mình thực hiện 1 macro thì ở vị trí ô nào nó cũng hiện thông báo, kể cả mình đặt tại vị trí cột C.
Nhờ các bạn sửa giúp để chỉ thông báo khi mình đặt vị trí làm việc ngoài cột C thôi, còn nếu trong cột C thì thực hiện lệnh copy.
Mình cảm ơn trước!

Kiểm tra lại chỗ màu đỏ. Khai báo As Single là ý gì?

nguyenkhoadng · 29/11/12

Mình tạo 1 nút bấm và assign đến 1 macro. vậy Nếu dựa vào đoạn code này mà sửa lại sao cho:
VD: Khi click vào nút bấm thì chỉ vị trí từ cột C dòng 5 trở xuống mới gọi đc macro. còn nếu ngoài vùng đó thì ko thể gọi đc macro và hiện thông báo.
P/s: Mình đang tập tành về code, mới ở mức độ copy, paste và tập đọc code. Nên các bạn thông cảm giúp.
Mình cảm ơn!

Quang_Hải · 29/11/12

nguyenkhoadng đã viết:
Mình tạo 1 nút bấm và assign đến 1 macro. vậy Nếu dựa vào đoạn code này mà sửa lại sao cho:
VD: Khi click vào nút bấm thì chỉ vị trí từ cột C dòng 5 trở xuống mới gọi đc macro. còn nếu ngoài vùng đó thì ko thể gọi đc macro và hiện thông báo.
P/s: Mình đang tập tành về code, mới ở mức độ copy, paste và tập đọc code. Nên các bạn thông cảm giúp.
Mình cảm ơn!

Nếu bạn biết sử dụng .Column thì nghiên cứu tiếp cái .Row nghen, rồi gán tiếp dk là nếu > 4 mới hoạt động

nguyenkhoadng · 29/11/12

Mã:

Private Sub ModClear_All()
On Error Resume Next
Anser = MsgBox("Ban co chac xoa toan bo de thong ke lai khong ?", vbDefaultButton1 + vbYesNo, " Are you sure ?")
If Anser = vbYes Then
    Deleteshape
    Range("A16:Q5000").Clear
    If [C18].Value <> "" Then
        Range([C17], [C17].End(xlDown)).Select
        Else: Range("C16:C17").Select
    End If
    Selection.Clear
    [C16].Select
End If
End Sub

Mình sử dụng đoạn code trên thì sẽ xóa toàn bộ những gì trong vùng A16:Q5000
nhưng các hình mình vẽ bằng line, và các hình mình group lại thì vẫn không xóa được.
nhờ các bạn giúp mình chỉnh lại code trên làm sao cho xóa được cả những hình vẽ trong excel.
*** Clear chứ không phải Delete, vì Delete nếu Delete vùng này thì dữ liệu vùng bên cạnh sẽ bị dồn về vùng vừa Delete
P/s: Mình tập trung các câu hỏi của mình về 1 topic này, để dễ theo dõi. Mong các bạn giúp.
Cảm ơn!

Quang_Hải · 29/11/12

Dim hinh
For Each hinh in ActiveSheet.Shapes
hinh.delete
Next

nguyenkhoadng · 29/11/12

Mã:

Private Sub CommandButton1_Click()[COLOR=#ff0000]Dim hinh[/COLOR]
[COLOR=#ff0000]For Each hinh In ActiveSheet.Shapes[/COLOR]
[COLOR=#ff0000]hinh.Delete[/COLOR]
[COLOR=#ff0000]Next[/COLOR]
On Error Resume Next
Anser = MsgBox("Ban co chac xoa toan bo de thong ke lai khong ?", vbDefaultButton1 + vbYesNo, " Are you sure ?")
If Anser = vbYes Then
    Deleteshape
    Range("A16:Q500").UnMerge
    Range("A16:Q500").Clear
    If [C18].Value <> "" Then
        Range([C17], [C17].End(xlDown)).Select
        Else: Range("C16:C17").Select
    End If
    Selection.Clear
    [C16].Select
End If
End Sub

Cảm ơn a!
Nhưng khi e thay vào vị trí như trên thì xóa sạch hình trong sheet luôn a ah. e chỉ muốn xóa trong vùng A16:Q500 thôi. nhờ a giúp.

sealand · 29/11/12

Sub để xoá Shape bạn viết như sau để không xoá nhầm các hình bên ngoài vùng xoá nha

Mã:

Sub Shape_Delete()
Dim Sh As Shape
For Each Sh In Sheet1.Shapes
If Sh.BottomRightCell.Column <= 17 Then
If Sh.BottomRightCell.Row <= 5000 Then
If Sh.BottomRightCell.Row >= 16 Then
Sh.Delete
End If: End If: End If
Next
End Sub

Theo mình viết Code bạn phải dẫn chiếu SheetName hay SheetNamecode cụ thể, tránh bỏ trống như bạn hoặc dùng Activesheet (Trừ phi dám chắc chạy code sheet mình cần xóa luôn active

nguyenkhoadng · 29/11/12

Cảm ơn a sealand!
Luôn tiện nói đến khoanh vùng làm việc, e nhờ a giúp đoạn code này:
Nếu con trỏ ở trong phạm vi A16:Q500 thì lệnh gọi macro mới có hiệu lực, còn nếu con trỏ ở ngoài vùng đó thì lệnh gọi macro không hiệu lực và sẽ hiện lên 1 thông báo yêu câu người dùng đưa con trỏ về đúng vị trí làm việc.
Nhờ a giúp!

sealand · 29/11/12

Em cho đoạn code sau vào trước các lệnh khác nha

Mã:

'-----------------
If Intersect(ActiveCell, Sheet1.[A16:Q500]) Is Nothing Then
MsgBox "Chuyen con tro vao vung A16:Q500 roi chay lenh", , "THONG BAO"
Exit Sub
End If
'-----------------------

nguyenkhoadng · 29/11/12

Mã:

Sub Macro1()[COLOR=#0000cd]'-----------------[/COLOR]
[COLOR=#ff0000]If Intersect(ActiveCell, Sheet1.[A16:Q500]) Is Nothing Then[/COLOR]
[COLOR=#0000cd]MsgBox "Chuyen con tro vao vung A16:Q500 roi chay lenh", , "THONG BAO"[/COLOR]
[COLOR=#0000cd]Exit Sub[/COLOR]
[COLOR=#0000cd]End If[/COLOR]
[COLOR=#0000cd]'-----------------------[/COLOR]
Call KHOA
i = ActiveCell.Row
Cells(i, "A").Select
    Sheets("DuLieuThepTron").Range("A16:Q16").Copy
    ActiveCell.Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 3).Select
End Sub

Cảm ơn a!
E chèn vào trước lệnh macro1 vậy đúng ko a? sao khi gọi macro1 thì nó lại báo lỗi và tô màu vàng đoạn code "If Intersect(ActiveCell, Sheet1.[A16:Q500]) Is Nothing Then"
Vậy chắc do e chèn không đúng chỗ đúng ko a? a giúp e sửa lại đoạn code trên cho hết lỗi với. e cảm ơn!

Quang_Hải · 29/11/12

nguyenkhoadng đã viết:
Mã:

Sub Macro1()[COLOR=#0000cd]'-----------------[/COLOR] [COLOR=#ff0000]If Intersect(ActiveCell, Sheet1.[A16:Q500]) Is Nothing Then[/COLOR] [COLOR=#0000cd]MsgBox "Chuyen con tro vao vung A16:Q500 roi chay lenh", , "THONG BAO"[/COLOR] [COLOR=#0000cd]Exit Sub[/COLOR] [COLOR=#0000cd]End If[/COLOR] [COLOR=#0000cd]'-----------------------[/COLOR] Call KHOA i = ActiveCell.Row Cells(i, "A").Select Sheets("DuLieuThepTron").Range("A16:Q16").Copy ActiveCell.Select ActiveSheet.Paste ActiveCell.Offset(0, 3).Select End Sub

Cảm ơn a!
E chèn vào trước lệnh macro1 vậy đúng ko a? sao khi gọi macro1 thì nó lại báo lỗi và tô màu vàng đoạn code "If Intersect(ActiveCell, ActiveSheet.[A16:Q500]) Is Nothing Then"
Vậy chắc do e chèn không đúng chỗ đúng ko a? a giúp e sửa lại đoạn code trên cho hết lỗi với. e cảm ơn!

Thay Sheet1 bằng Activesheet xem sao

nguyenkhoadng · 30/11/12

Mã:

Sub ModBang_moi()
    On Error Resume Next
    Sheets("BangGoc").Copy After:=Sheets("BangGoc")
    ActiveSheet.Name = "Bang-01"
    Range("G9").Font.Italic = True
    Range("G9") = """TEN MOI CUA BANG"""
    Range("C16").Select
End Sub

E có một vấn đề muốn nhờ các a trên GPE hướng dẫn giúp.
Ví dụ:
E có một file excel gổm có 2 sheet (sheet "GioiThieu" và sheet "BangGoc") trong đó e cho sheet "BangGoc" ẩn đi. khi vào file excel chỉ thấy sheet "GioiThieu" thôi.
Trên sheet "GioiThieu" có 1 nút để gọi lệnh tạo 1 bảng mới copy từ sheet "BanGoc" có tên "Bang-01" và sheet "Ban-01" này hiện ra để e làm việc. (sheet "BangGoc" vẫn bị ẩn)
Nhưng khi e dùng đoạn code trên thì gọi được lệnh tạo bảng mới có tên "Bang-01", nhưng sheet "Bang-01" này bị ẩn chứ ko hiện ra như mong muốn.
Nhờ các a trên GPE giúp e chỉnh lại đoạn code theo mong muốn ở trên của e với.
E cảm ơn!

viehoai · 30/11/12

nguyenkhoadng đã viết:
Mã:

Sub ModBang_moi() On Error Resume Next Sheets("BangGoc").Copy After:=Sheets("BangGoc") ActiveSheet.Name = "Bang-01" Range("G9").Font.Italic = True Range("G9") = """TEN MOI CUA BANG""" Range("C16").Select End Sub

E có một vấn đề muốn nhờ các a trên GPE hướng dẫn giúp.
Ví dụ:
E có một file excel gổm có 2 sheet (sheet "GioiThieu" và sheet "BangGoc") trong đó e cho sheet "BangGoc" ẩn đi. khi vào file excel chỉ thấy sheet "GioiThieu" thôi.
Trên sheet "GioiThieu" có 1 nút để gọi lệnh tạo 1 bảng mới copy từ sheet "BanGoc" có tên "Bang-01" và sheet "Ban-01" này hiện ra để e làm việc. (sheet "BangGoc" vẫn bị ẩn)
Nhưng khi e dùng đoạn code trên thì gọi được lệnh tạo bảng mới có tên "Bang-01", nhưng sheet "Bang-01" này bị ẩn chứ ko hiện ra như mong muốn.
Nhờ các a trên GPE giúp e chỉnh lại đoạn code theo mong muốn ở trên của e với.
E cảm ơn!

Thêm câu lệnh này thử xem nhé
ActiveSheet.Visible = True

nguyenkhoadng · 30/11/12

viehoai đã viết:
Thêm câu lệnh này thử xem nhé
ActiveSheet.Visible = True

Với 1 câu lệnh ngắn gọn để giải quyết 1 câu hỏi dài dòng. Cảm ơn a viehoai!
Cũng với đoạn code trên nhưng sao e chỉ tạo được 1 sheet mới với tên "Bang-01" thôi vậy a?
các sheet còn lại thì có tên "BangGoc(2)", "BangGoc(3)",...
Cho e hỏi làm sao để những lần gọi lệnh tạo bảng mới thì các bảng sau đều có tên "Bang-02", "Bang-03", ...
e cảm ơn!

viehoai · 30/11/12

nguyenkhoadng đã viết:
Với 1 câu lệnh ngắn gọn để giải quyết 1 câu hỏi dài dòng. Cảm ơn a viehoai!
Cũng với đoạn code trên nhưng sao e chỉ tạo được 1 sheet mới với tên "Bang-01" thôi vậy a?
các sheet còn lại thì có tên "BangGoc(2)", "BangGoc(3)",...
Cho e hỏi làm sao để những lần gọi lệnh tạo bảng mới thì các bảng sau đều có tên "Bang-02", "Bang-03", ...
e cảm ơn!

Bạn dùng code này thử xem nhé

Mã:

Sub CopySheet()
Dim Num As Integer
Dim Sh As Worksheet
For Each Sh In Worksheets
   If InStr(1, Sh.Name, "BangGoc") Then
      Num = Num + 1
   End If
Next
Sheets("BangGoc").Copy After:=Sheets("BangGoc")
With ActiveSheet
  .Name = "Bang-" & Format(Num, "00")
  .Visible = True
End With
End Sub

nguyenkhoadng · 30/11/12

Mã:

Sub Hinh1()
Dim i As Integer
i = ActiveCell.Row
Cells(i, "A").Select
    Sheets("DuLieu").Range("A16:P16").Copy
    ActiveCell.Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 6).Select
End Sub


Sub Hinh2()
i = ActiveCell.Row
Cells(i, "A").Select
    Sheets("DuLieu").Range("A17:P17").Copy
    ActiveCell.Select
    ActiveSheet.Paste
    ActiveCell.Offset(0, 6).Select
End Sub

Cảm ơn a!
Càng khám phá thấy càng thú vị, nhưng dễ bị tẩu hỏa nhập ma quá

------------------------------
E có câu hỏi này:
VD: E có đoạn code bên trên, tác dụng của nó là copy dữ liệu vùng A16

16 từ sheet "DuLieu" và paste vào sheet đang làm việc. nhưng theo code trên thì e đặt con trỏ ở vị trí nào thì dữ liệu sẽ được paste vào vị trí đó (Chỉ paste cố định được cột, nghĩa là vị trí dữ liệu copy và vị trí dữ liệu paste vào cùng cột A)
Nếu e muốn dữ liệu copy được sẽ paste vào vị trí cột A như trên và vị trí dòng 4 trở xuống.
(VD:
lần thứ 1: Gọi macro Hinh1, sẽ copy dữ liệu vùng A16

16 của sheet "DuLieu" và paste vào vị trí A4

4 của sheet hiện hành.
lần thứ 2: Gọi macro Hinh2, sẽ copy dữ liệu vùng A17

17 của sheet "DuLieu" và paste vào vị trí A5

5 của sheet hiện hành.
và ngược lại
lần thứ 1: Gọi macro Hinh2, sẽ copy dữ liệu vùng A16

16 của sheet "DuLieu" và paste vào vị trí A4

4 của sheet hiện hành.
lần thứ 2: Gọi macro Hinh1, sẽ copy dữ liệu vùng A17

17 của sheet "DuLieu" và paste vào vị trí A5

5 của sheet hiện hành.)

E cảm ơn!

viehoai · 1/12/12

nguyenkhoadng đã viết:
Mã:

Sub Hinh1() Dim i As Integer i = ActiveCell.Row Cells(i, "A").Select Sheets("DuLieu").Range("A16:P16").Copy ActiveCell.Select ActiveSheet.Paste ActiveCell.Offset(0, 6).Select End Sub Sub Hinh2() i = ActiveCell.Row Cells(i, "A").Select Sheets("DuLieu").Range("A17:P17").Copy ActiveCell.Select ActiveSheet.Paste ActiveCell.Offset(0, 6).Select End Sub

Cảm ơn a!
Càng khám phá thấy càng thú vị, nhưng dễ bị tẩu hỏa nhập ma quá
------------------------------
E có câu hỏi này:
VD: E có đoạn code bên trên, tác dụng của nó là copy dữ liệu vùng A1616 từ sheet "DuLieu" và paste vào sheet đang làm việc. nhưng theo code trên thì e đặt con trỏ ở vị trí nào thì dữ liệu sẽ được paste vào vị trí đó (Chỉ paste cố định được cột, nghĩa là vị trí dữ liệu copy và vị trí dữ liệu paste vào cùng cột A)
Nếu e muốn dữ liệu copy được sẽ paste vào vị trí cột A như trên và vị trí dòng 4 trở xuống.
(VD:
lần thứ 1: Gọi macro Hinh1, sẽ copy dữ liệu vùng A1616 của sheet "DuLieu" và paste vào vị trí A44 của sheet hiện hành.
lần thứ 2: Gọi macro Hinh2, sẽ copy dữ liệu vùng A1717 của sheet "DuLieu" và paste vào vị trí A55 của sheet hiện hành.
và ngược lại
lần thứ 1: Gọi macro Hinh2, sẽ copy dữ liệu vùng A1616 của sheet "DuLieu" và paste vào vị trí A44 của sheet hiện hành.
lần thứ 2: Gọi macro Hinh1, sẽ copy dữ liệu vùng A17 17 của sheet "DuLieu" và paste vào vị trí A55 của sheet hiện hành.)

E cảm ơn!

1. Không biết bài trên (#16) bạn test chưa? Thấy nhấn nút cảm ơn mà không thấy phản hồi, trong khi đó code sai chưa đúng yêu cầu của bạn (bây giờ mở ra tôi mới thấy sai)
2. Câu hỏi bài này với code bạn đưa chưa được cái gì để mọi người giúp tiếp? (vấn đề tối ưu code tính sau)

nguyenkhoadng · 1/12/12

viehoai đã viết:
1. Không biết bài trên (#16) bạn test chưa? Thấy nhấn nút cảm ơn mà không thấy phản hồi, trong khi đó code sai chưa đúng yêu cầu của bạn (bây giờ mở ra tôi mới thấy sai)
2. Câu hỏi bài này với code bạn đưa chưa được cái gì để mọi người giúp tiếp? (vấn đề tối ưu code tính sau)

Mã:

Sub Hinh1()
         Dim i As Integer
         i = ActiveCell.RowCells(i, "A").Select    
         Sheets("DuLieu").Range("A16:P16").Copy    
         ActiveCell.Select    
         ActiveSheet.Paste    
         ActiveCell.Offset(0, 6).Select
End Sub
Sub Hinh2()
         i = ActiveCell.RowCells(i, "A").Select    
         Sheets("DuLieu").Range("A17:P17").Copy    
         ActiveCell.Select   
         ActiveSheet.Paste    
         ActiveCell.Offset(0, 6).Select
End Sub
Sub Hinh3()
         i = ActiveCell.RowCells(i, "A").Select    
         Sheets("DuLieu").Range("A18:P18").Copy    
         ActiveCell.Select    
         ActiveSheet.Paste    
         ActiveCell.Offset(0, 6).Select
End Sub
Sub Hinh4()
          i = ActiveCell.RowCells(i, "A").Select    
         Sheets("DuLieu").Range("A19:P19").Copy    
         ActiveCell.Select    
         ActiveSheet.Paste    
         ActiveCell.Offset(0, 6).Select
End Sub

1. Bài #16 e test rồi, và thấy đúng yêu cầu của e. vậy code sai ở chỗ nào vậy a, a có thể nói để e biết thêm không a?
2. Yêu cầu của e với đoạn code này là:
VD: e có rất nhiều macro Hinh (gồm Hinh1, Hinh2, Hinh3, Hinh4, .....)
vậy phải sửa code làm sao để:
lần 1: gọi macro Hinh3, sẽ copy dữ liệu vùng A1818 của sheet "DuLieu" và paste vào vị trí A44 của sheet hiện hành.
lần 2: gọi macro Hinh1, sẽ copy dữ liệu vùng A1616 của sheet "DuLieu" và paste vào vị trí A55 của sheet hiện hành.
lần 3: gọi macro Hinh4, sẽ copy dữ liệu vùng A1919 của sheet "DuLieu" và paste vào vị trí A66 của sheet hiện hành.
lần 4: gọi macro Hinh2, sẽ copy dữ liệu vùng A1717 của sheet "DuLieu" và paste vào vị trí A77 của sheet hiện hành.
.......
Có nghĩa là dữ liệu mà gọi macro để copy thì ngẫu nhiên theo ý mình, còn vị trí paste thì bắt buộc phải paste vào vùng A44 trở xuống.

E cảm ơn!

viehoai · 1/12/12

nguyenkhoadng đã viết:
Mã:

Sub Hinh1() Dim i As Integer i = ActiveCell.RowCells(i, "A").Select Sheets("DuLieu").Range("A16:P16").Copy ActiveCell.Select ActiveSheet.Paste ActiveCell.Offset(0, 6).Select End Sub Sub Hinh2() i = ActiveCell.RowCells(i, "A").Select Sheets("DuLieu").Range("A17:P17").Copy ActiveCell.Select ActiveSheet.Paste ActiveCell.Offset(0, 6).Select End Sub Sub Hinh3() i = ActiveCell.RowCells(i, "A").Select Sheets("DuLieu").Range("A18:P18").Copy ActiveCell.Select ActiveSheet.Paste ActiveCell.Offset(0, 6).Select End Sub Sub Hinh4() i = ActiveCell.RowCells(i, "A").Select Sheets("DuLieu").Range("A19:P19").Copy ActiveCell.Select ActiveSheet.Paste ActiveCell.Offset(0, 6).Select End Sub

1. Bài #16 e test rồi, và thấy đúng yêu cầu của e. vậy code sai ở chỗ nào vậy a, a có thể nói để e biết thêm không a?
2. Yêu cầu của e với đoạn code này là:
VD: e có rất nhiều macro Hinh (gồm Hinh1, Hinh2, Hinh3, Hinh4, .....)
vậy phải sửa code làm sao để:
lần 1: gọi macro Hinh3, sẽ copy dữ liệu vùng A1818 của sheet "DuLieu" và paste vào vị trí A44 của sheet hiện hành.
lần 2: gọi macro Hinh1, sẽ copy dữ liệu vùng A1616 của sheet "DuLieu" và paste vào vị trí A55 của sheet hiện hành.
lần 3: gọi macro Hinh4, sẽ copy dữ liệu vùng A1919 của sheet "DuLieu" và paste vào vị trí A66 của sheet hiện hành.
lần 4: gọi macro Hinh2, sẽ copy dữ liệu vùng A1717 của sheet "DuLieu" và paste vào vị trí A77 của sheet hiện hành.
.......
Có nghĩa là dữ liệu mà gọi macro để copy thì ngẫu nhiên theo ý mình, còn vị trí paste thì bắt buộc phải paste vào vùng A44 trở xuống.

E cảm ơn!

1. Bài trên code không đúng khi bạn chạy nhiều lần (copy nhiều Sheet). Trước khi đưa lên mình có Test nhưng khi post bài lại có sửa nên sai
Code đúng là

Mã:

Sub CopySheet()Dim Num As Integer
Dim Sh As Worksheet
For Each Sh In Worksheets
   If InStr(1, Sh.Name, "Bang") Then
      Num = Num + 1
   End If
Next
Sheets("BangGoc").Copy After:=Sheets("BangGoc")
With ActiveSheet
  .Name = "Bang-" & Format(Num + 1, "00")
  .Visible = True
End With
End Sub

2. Bạn test code này rồi cho ý kiến nhé

Mã:

Sub CopyRange()On Error Resume Next
Dim Rng As Range
Set Rng = Application.InputBox("Chon Range can Copy", Type:=8)
Rng.Copy Range("A" & ActiveCell.Row)
End Sub

Hoặc có thể dùng

Mã:

Sub CopyRange()On Error Resume Next
Dim Rng As Range
Set Rng = Application.InputBox("Chon Range can Copy", Type:=8)
Rng.Copy Range("A65500").End(3).Offset(1)
End Sub

nguyenkhoadng · 1/12/12

viehoai đã viết:
1. Bài trên code không đúng khi bạn chạy nhiều lần (copy nhiều Sheet). Trước khi đưa lên mình có Test nhưng khi post bài lại có sửa nên sai
Code đúng là

Mã:

Sub CopySheet()Dim Num As Integer Dim Sh As Worksheet For Each Sh In Worksheets If InStr(1, Sh.Name, "Bang") Then Num = Num + 1 End If Next Sheets("BangGoc").Copy After:=Sheets("BangGoc") With ActiveSheet .Name = "Bang-" & Format([COLOR=#ff0000]Num + 1[/COLOR], "00") .Visible = True End With End Sub

2. Bạn test code này rồi cho ý kiến nhé

Mã:

Sub CopyRange()On Error Resume Next Dim Rng As Range Set Rng = Application.InputBox("Chon Range can Copy", Type:=8) Rng.Copy Range("A" & ActiveCell.Row) End Sub

Hoặc có thể dùng

Mã:

Sub CopyRange()On Error Resume Next Dim Rng As Range Set Rng = Application.InputBox("Chon Range can Copy", Type:=8) Rng.Copy Range("A65500").End(3).Offset(1) End Sub

1. Code đầu sai mà vô tình đúng với ý e a ah, vì e xem như sheet ẩn là ko có, vậy nên các sheet đc copy sẽ có tên bắt đầu là 01,02... còn code trên thì các sheet đc copy có tên bắt đầu là 02,03,...
2. e test thử đoạn code này thì nó hiện ra 1 cửa sổ Input.
có thể câu hỏi của e chưa rõ ràng lắm. e up file excel lên cho a dễ hình dung.
a để con trỏ bắt kỳ rồi gọi macro 1,2,3,... thì sẽ rõ. nó sẽ paste vào vị trí mình đặt con trỏ chứ ko paste theo từng dòng quy định từ trên xuống a ah.

viehoai · 1/12/12

nguyenkhoadng đã viết:
2. e test thử đoạn code này thì nó hiện ra 1 cửa sổ Input.
có thể câu hỏi của e chưa rõ ràng lắm. e up file excel lên cho a dễ hình dung.
a để con trỏ bắt kỳ rồi gọi macro 1,2,3,... thì sẽ rõ. nó sẽ paste vào vị trí mình đặt con trỏ chứ ko paste theo từng dòng quy định từ trên xuống a ah.

Nếu dán tại Cell hiện hành thì dùng

Mã:

Sub CopyRange()On Error Resume Next
Dim Rng As Range
Set Rng = Application.InputBox("Chon Range can Copy", Type:=8)
Rng.Copy ActiveCell
End Sub

Sử dụng InputBox để bạn chọn Range cần copy, chẳng nhẻ có 1000 Range cần copy như thế bạn lại sử dụng 1000 Sub ????

nguyenkhoadng · 1/12/12

viehoai đã viết:
Nếu dán tại Cell hiện hành thì dùng

Mã:

Sub CopyRange()On Error Resume Next Dim Rng As Range Set Rng = Application.InputBox("Chon Range can Copy", Type:=8) Rng.Copy ActiveCell End Sub

Sử dụng InputBox để bạn chọn Range cần copy, chẳng nhẻ có 1000 Range cần copy như thế bạn lại sử dụng 1000 Sub ????

vì e copy dữ liệu ở sheet khác nên phải vậy a ah. e làm thêm nút nhấn để assign đến từng macro rồi ở sheet hiện hành và click vào đó là được.
Chỉ có điều chưa ưng ý ở vị trí paste vào sheet hiện hành thôi a ah.
a xem ở file e đính kèm ở trên xem có giúp được e ko?
cảm ơn a!

viehoai · 1/12/12

nguyenkhoadng đã viết:
vì e copy dữ liệu ở sheet khác nên phải vậy a ah. e làm thêm nút nhấn để assign đến từng macro rồi ở sheet hiện hành và click vào đó là được.
Chỉ có điều chưa ưng ý ở vị trí paste vào sheet hiện hành thôi a ah.
a xem ở file e đính kèm ở trên xem có giúp được e ko?
cảm ơn a!

Nếu vậy thì code bạn đã thực hiện được rồi, còn cái gì "chưa ưng ý" ?
Mà mình thấy có nhiều phần mềm thống kê cốt thép rồi, diễn đàn ta cũng có sao bạn không tham khảo xem?

nguyenkhoadng · 1/12/12

viehoai đã viết:
Nếu vậy thì code bạn đã thực hiện được rồi, còn cái gì "chưa ưng ý" ?
Mà mình thấy có nhiều phần mềm thống kê cốt thép rồi, diễn đàn ta cũng có sao bạn không tham khảo xem?

code của e giải quyết được phần copy và paste, nhưng nó chỉ paste ở dòng mình đặt con trỏ thôi. có nghĩa là dòng nào mình đặt con trỏ thì nó paste ở đó tính từ cột A, và nó ko cần biết ở trên có dòng trống hay ko. như vậy thì sẽ mất thêm 1 thao tác đưa con trỏ đến đúng dòng cần paste. e muốn sao cho bất kỳ mình đặt con trỏ ở đâu thì khi gọi macro nó vẫn tìm đúng vị trí dòng trống bên dưới để paste vào. như vậy rất tiện a ah.
P/s: tuy trên diễn đàn có rất nhiều thống kê thép trên excel, e đã tham khảo rất nhiều nhưng chưa thấy file nào đáp ứng được yêu cầu như trên a ah. mặc khác e muốn mày mò, học hỏi thêm về code VBA nên nhờ các a giúp để có thể tích góp tạo được 1 file của mình, cái gì của mình thì sau này dễ quản lý hơn. nhờ vậy e có thể làm đc thêm những file khác giúp ích cho công việc của mình nữa.

viehoai · 1/12/12

nguyenkhoadng đã viết:
code của e giải quyết được phần copy và paste, nhưng nó chỉ paste ở dòng mình đặt con trỏ thôi. có nghĩa là dòng nào mình đặt con trỏ thì nó paste ở đó tính từ cột A, và nó ko cần biết ở trên có dòng trống hay ko. như vậy thì sẽ mất thêm 1 thao tác đưa con trỏ đến đúng dòng cần paste. e muốn sao cho bất kỳ mình đặt con trỏ ở đâu thì khi gọi macro nó vẫn tìm đúng vị trí dòng trống bên dưới để paste vào. như vậy rất tiện a ah.

Nếu vậy thay vì

Mã:

ActiveCell.Select

Thì dùng

Mã:

Range("B65500").End(3).Offset(1, -1).Select

Vậy thì mâu thuẫn bài 21 và bạn nói

nó sẽ paste vào vị trí mình đặt con trỏ chứ ko paste theo từng dòng quy định từ trên xuống a ah

nguyenkhoadng · 1/12/12

viehoai đã viết:
Nếu vậy thay vì

Mã:

ActiveCell.Select

Thì dùng

Mã:

Range("B65500").End(3).Offset(1, -1).Select

Vậy thì mâu thuẫn bài 21 và bạn nói

e thay như trên thì khi gọi macro lần đầu tiên thì nó sẽ paste vào dòng 15 (Dòng e ẩn), và các lần sau vẫn cứ paste chồng vào dòng 15 đó.
nhưng nếu e hiện unhide dòng 15 thì nó mới paste xuống mấy dòng bên dưới a ah. như vậy là bị sao vậy a?
p/s: bài #21 không mâu thuẫn đâu a, màu đỏ là ý e muốn, còn màu đen là đoạn code đó thực hiện.

nó sẽ paste vào vị trí mình đặt con trỏ chứ ko paste theo từng dòng quy định từ trên xuống a ah

viehoai · 1/12/12

nguyenkhoadng đã viết:
e thay như trên thì khi gọi macro lần đầu tiên thì nó sẽ paste vào dòng 15 (Dòng e ẩn), và các lần sau vẫn cứ paste chồng vào dòng 15 đó.
nhưng nếu e hiện unhide dòng 15 thì nó mới paste xuống mấy dòng bên dưới a ah. như vậy là bị sao vậy a?
p/s: bài #21 không mâu thuẫn đâu a, màu đỏ là ý e muốn, còn màu đen là đoạn code đó thực hiện.

Bạn chạy code này nhiều lần thử xem nhé

Mã:

Sub Macro1()Dim i As Integer
i = Range("B65500").End(xlUp).Row + 1
If i <= 16 Then i = 16
   Sheets("DuLieuThepTron").Range("A7:O7").Copy
    Range("A" & i).Select
    ActiveSheet.Paste
End Sub

nguyenkhoadng · 1/12/12

viehoai đã viết:
Bạn chạy code này nhiều lần thử xem nhé

Mã:

Sub Macro1()Dim i As Integer i = Range("B65500").End(xlUp).Row + 1 If i <= 16 Then i = 16 Sheets("DuLieuThepTron").Range("A7:O7").Copy Range("A" & i).Select ActiveSheet.Paste End Sub

Code này chạy đúng như e muốn rồi a ah.
Dùng code này thấy nó paste mượt hơn code trc e dùng

cảm ơn a nhiều!
a cho e hỏi có đoạn code nào xóa dòng mình chọn (xóa chữ và hình luôn đó a)
ví dụ mình chỉ cần click con trỏ vào bất kỳ ô nào thuộc dòng đó từ cột A:O
và gọi macro thì chữ dòng đó sẽ bị clear, còn hình bị delete. (ở đây e muốn clear chữ vì nếu delete dòng này thì các dữ liệu xung quang sẽ dồn lại)

p/s: thật sự càng tìm hiểu càng khoái, mà e ko biết hỏi nhiều có gây khó chịu cho các a ko vậy? hỏi thật để rút kinh nghiệm hỏi ít lại thôi.

viehoai · 1/12/12

nguyenkhoadng đã viết:
Code này chạy đúng như e muốn rồi a ah.
Dùng code này thấy nó paste mượt hơn code trc e dùng
cảm ơn a nhiều!
a cho e hỏi có đoạn code nào xóa dòng mình chọn (xóa chữ và hình luôn đó a)
ví dụ mình chỉ cần click con trỏ vào bất kỳ ô nào thuộc dòng đó từ cột A:O
và gọi macro thì chữ dòng đó sẽ bị clear, còn hình bị delete. (ở đây e muốn clear chữ vì nếu delete dòng này thì các dữ liệu xung quang sẽ dồn lại)

p/s: thật sự càng tìm hiểu càng khoái, mà e ko biết hỏi nhiều có gây khó chịu cho các a ko vậy? hỏi thật để rút kinh nghiệm hỏi ít lại thôi.

Đầu tiên bạn xóa đối tượng trong dòng rồi xóa dòng sau
Để xóa đối tượng trong dòng đó bạn sử dụng code

Mã:

For i = 1 To ActiveSheet.Shapes.Count
If ActiveCell.Top <= ActiveSheet.Shapes(i).Top And ActiveCell.Offset(1).Top >= ActiveSheet.Shapes(i).Top _
And ActiveSheet.Shapes(i).Left < Range("P" & ActiveCell.Row).Left Then
   Sheet2.Shapes(i).Delete
End If
Next

Còn việc xóa dòng chắc bạn đã biết

nguyenkhoadng · 1/12/12

viehoai đã viết:
Bạn chạy code này nhiều lần thử xem nhé

Mã:

Sub Macro1()Dim i As Integer i = Range("B65500").End(xlUp).Row + 1 If i <= 16 Then i = 16 Sheets("DuLieuThepTron").Range("A7:O7").Copy Range("A" & i).Select ActiveSheet.Paste End Sub

Cảm ơn a! việc xóa dòng đã ok

e đi sâu vào đoạn code này chút.
như đoạn code trên thì sẽ tự paste vào những dòng bên dưới.
giờ nếu muốn cho nó thêm chức năng kiểm tra từ dòng 16 xuống dưới nếu có dòng trống thì sẽ paste vào đó, còn nếu không có dòng trống thì mới paste vào dòng tiếp theo bên dưới.
Nếu làm việc đc như vậy thì sẽ hoàn thiện hơn trong việc nhập dữ liệu.
vậy phải chỉnh đoạn code lại như thế nào cho đúng vậy a?

viehoai · 1/12/12

nguyenkhoadng đã viết:
Cảm ơn a! việc xóa dòng đã ok
e đi sâu vào đoạn code này chút.
như đoạn code trên thì sẽ tự paste vào những dòng bên dưới.
giờ nếu muốn cho nó thêm chức năng kiểm tra từ dòng 16 xuống dưới nếu có dòng trống thì sẽ paste vào đó, còn nếu không có dòng trống thì mới paste vào dòng tiếp theo bên dưới.
Nếu làm việc đc như vậy thì sẽ hoàn thiện hơn trong việc nhập dữ liệu.
vậy phải chỉnh đoạn code lại như thế nào cho đúng vậy a?

Bạn tư duy thêm tý là được thôi mà, tự làm sẽ nhớ lâu hơn

Mã:

Sub Macro1()
Dim i As Integer
Dim Rng As Range
Application.ScreenUpdating = False
i = Range("B65500").End(xlUp).Row + 1
If i <= 16 Then i = 16
For Each Rng In Range("B16:B" & i)
   If Rng.Value = "" Then
     i = Rng.Row
     Exit For
   End If
Next
   Sheets("DuLieuThepTron").Range("A7:O7").Copy
    Range("A" & i).Select
    ActiveSheet.Paste
Application.ScreenUpdating = True
End Sub

nguyenkhoadng · 1/12/12

viehoai đã viết:

Bạn tư duy thêm tý là được thôi mà, tự làm sẽ nhớ lâu hơn

Mã:

Sub Macro1()
Dim i As Integer
Dim Rng As Range
Application.ScreenUpdating = False
i = Range("B65500").End(xlUp).Row + 1
If i <= 16 Then i = 16
For Each Rng In Range("B16:B" & i)
   If Rng.Value = "" Then
     i = Rng.Row
     Exit For
   End If
Next
   Sheets("DuLieuThepTron").Range("A7:O7").Copy
    Range("A" & i).Select
    ActiveSheet.Paste
Application.ScreenUpdating = True
End Sub

Cảm ơn a!
Thật sự để tư duy được mấy cái code vba này thì cũng phải có chút vốn kiến thức về nó a ah. e mới tìm hiểu về nó mới hơn 1 tuần nên về tư duy cũng hơi bị khó.
Cảm ơn a đã hướng dẫn nhiệt tình!
file thống kê của e đã tương đối hoàn chỉnh rồi. giờ đến quá trình sử dụng thôi.
Một lần nữa cảm ơn các a trên diễn đàn GPE đã giúp đỡ nhiệt tình!
Chúc cuối tuần vui vẻ!

viehoai · 1/12/12

nguyenkhoadng đã viết:
Cảm ơn a!
Thật sự để tư duy được mấy cái code vba này thì cũng phải có chút vốn kiến thức về nó a ah. e mới tìm hiểu về nó mới hơn 1 tuần nên về tư duy cũng hơi bị khó.
Cảm ơn a đã hướng dẫn nhiệt tình!
file thống kê của e đã tương đối hoàn chỉnh rồi. giờ đến quá trình sử dụng thôi.
Một lần nữa cảm ơn các a trên diễn đàn GPE đã giúp đỡ nhiệt tình!
Chúc cuối tuần vui vẻ!

Nếu đã hoàn chỉnh đưa file lên mình xem góp ý thêm cho bạn, biết đâu tối ưu được code cho bạn sử dụng nhanh, tốt hơn

nguyenkhoadng · 1/12/12

viehoai đã viết:
Nếu đã hoàn chỉnh đưa file lên mình xem góp ý thêm cho bạn, biết đâu tối ưu được code cho bạn sử dụng nhanh, tốt hơn

Có gì nhờ a chỉnh sửa tối ưu code giúp.
ah, còn 1 điểm nhỏ nữa:
1. cái chữ "tổng hợp thép" trong sheet "BTK THÉP TRÒN" khi chạy thống kê thép nó ko hiển thị tiếng việt được.
2. Còn 2 công thức ở bảng TỔNG HỢP THÉP TRÒN e ko biết đưa vào trong code nên để ở ngoài sheet (ở vị trí T16 và U16), a giúp e đưa nó vào trong code khi chạy thống kê mới hiện.
3. Nếu bên BẢNG THỐNG KÊ THÉP có 1 dòng công tác hoặc không có dòng công tác thì khi chạy tổng hợp thép nó báo lỗi. a giúp e khắc phục cái vụ này bằng 1 thông báo đại loại như "ko tìm thấy dữ liệu trong bảng thống kê".
E cảm ơn trước!

viehoai · 1/12/12

nguyenkhoadng đã viết:
Có gì nhờ a chỉnh sửa tối ưu code giúp.
ah, còn 1 điểm nhỏ nữa:
1. cái chữ "tổng hợp thép" trong sheet "BTK THÉP TRÒN" khi chạy thống kê thép nó ko hiển thị tiếng việt được.
2. Còn 2 công thức ở bảng TỔNG HỢP THÉP TRÒN e ko biết đưa vào trong code nên để ở ngoài sheet (ở vị trí T16 và U16), a giúp e đưa nó vào trong code khi chạy thống kê mới hiện.
3. Nếu bên BẢNG THỐNG KÊ THÉP có 1 dòng công tác hoặc không có dòng công tác thì khi chạy tổng hợp thép nó báo lỗi. a giúp e khắc phục cái vụ này bằng 1 thông báo đại loại như "ko tìm thấy dữ liệu trong bảng thống kê".
E cảm ơn trước!

Còn nhiều điều cần góp ý đây. Nhưng bạn làm xong bạn không chạy thử lại từ đầu à? mình thự hiện bước đầu đã thấy lỗi tại

Mã:

Sheets("BTK THÉP TR̉N").Copy After:=Sheets("BTK THÉP TR̉N")

Nên làm như thế này
1. Không nên đặt tên Sheet có dấu và có ký tự trống (tự gây khó cho mình thôi chẳng được gì)
2. Nếu như trên thì thay code dưới đây thì có đặt tên kiểu gì tùy

Mã:

Sheet1.Copy After:=Sheet1

Cũng như

Mã:

.Name = "BTK THÉP TR̉N - " & Format(Num, "00")

Đổi thành là

Mã:

.Name = Sheet1.Name & "-" & Format(Num, "00")

Nói chung còn nhiều cái nữa để mình xem thêm góp ý một lần cho bạn luôn. Bảng tổng hợp trông có vẽ rườm rà lắm, cái này xem sau

nguyenkhoadng · 1/12/12

viehoai đã viết:
Còn nhiều điều cần góp ý đây. Nhưng bạn làm xong bạn không chạy thử lại từ đầu à? mình thự hiện bước đầu đã thấy lỗi tại

Mã:

Sheets("BTK THÉP TR̉N").Copy After:=Sheets("BTK THÉP TR̉N")

Nên làm như thế này
1. Không nên đặt tên Sheet có dấu và có ký tự trống (tự gây khó cho mình thôi chẳng được gì)
2. Nếu như trên thì thay code dưới đây thì có đặt tên kiểu gì tùy

Mã:

Sheet1.Copy After:=Sheet1

Cũng như

Mã:

.Name = "BTK THÉP TR̉N - " & Format(Num, "00")

Đổi thành là

Mã:

.Name = Sheet1.Name & "-" & Format(Num, "00")

Nói chung còn nhiều cái nữa để mình xem thêm góp ý một lần cho bạn luôn. Bảng tổng hợp trông có vẽ rườm rà lắm, cái này xem sau

Đúng là đặt tiếng việt trong code thấy khó chịu thiệt đó a, hên là BTK THÉP TRÒN với THÉP HÌNH còn ghi tiếng việt đc (ko bị dấu ???)

E đợi bản chỉnh sửa và tối ưu của a để so sánh học hỏi thêm mới đc.

viehoai · 1/12/12

nguyenkhoadng đã viết:
Đúng là đặt tiếng việt trong code thấy khó chịu thiệt đó a, hên là BTK THÉP TRÒN với THÉP HÌNH còn ghi tiếng việt đc (ko bị dấu ???)
E đợi bản chỉnh sửa và tối ưu của a để so sánh học hỏi thêm mới đc.

Tất cả đều bị nốt
Mình góp ý một số ý cơ bản bạn nghiên cứu trong thời gian nghiên cứu code tiếp
1. Điều quan trọng khi bạn thay đổi gì của Excel thì khi thoát PHẢI TRẢ LẠI nguyên trạng
2. Theo như file của bạn là file chương trình, chẳng nhẻ mỗi lần thống kế cho 1 công trình là 1 file nhứ thế ?? file thống kê cốt thép nên không chứa code gì cả. Để khắc phục vấn đề này bạn tham khảo file mình rồi cho ý kiến
Như vậy sau này ta làm 1 file AddIn để cần dùng bất cứ khi nào
3. Số hiệu thanh thép bạn sử dụng công thức là giá trị cell kế trên cộng thêm 1. Vậy bạn làm xong bạn xóa 1 dòng thì nó sẽ lỗi ngay. Bạn nên dùng hàm COUNTA()
Bạn nghiên cứu những ý trên rồi mình sẽ bàn tiếp

nguyenkhoadng · 2/12/12

1. a cho 1 ví dụ mà e mắc phải để e dễ hiểu hơn.
2. ý kiến này rất hợp lý, và e sẽ xây dựng file của e theo hướng này.
3. a có thể giúp cái hàm COUNTA() này ko? e chưa dùng nó bao giờ

p/s:
1. e có thắc mắc nếu chuyển thành addin thì khi muốn bổ sung vào file dữ liệu ta làm cách nào? e mở file addin lên ko có sheet nào cả?
2. Nếu có nhiều thép thì khi sử dụng userform có hạn chế ko? e thấy mấy cái button đó đặt cũng có giới hạn của nó, đặt nhiều quá thì đòi hỏi userform sẽ lớn hơn và như vậy sẽ choáng màn hình. có cách nào tạo list ko a?

viehoai · 2/12/12

1. Ban thay đổi Caption của Excel và file khi mở tạo menu TKTE2012 mà khi thoát Excel không trở lại tên mặt định và menu đó không xóa
2. Bạn dùng công thức này ở cột C sheet DuLieuThepTron =COUNTA(INDIRECT("C16:C" & ROW()-1))+1
3.

1. e có thắc mắc nếu chuyển thành addin thì khi muốn bổ sung vào file dữ liệu ta làm cách nào? e mở file addin lên ko có sheet nào cả?
2. Nếu có nhiều thép thì khi sử dụng userform có hạn chế ko? e thấy mấy cái button đó đặt cũng có giới hạn của nó, đặt nhiều quá thì đòi hỏi userform sẽ lớn hơn và như vậy sẽ choáng màn hình. có cách nào tạo list ko a?

3.1. Cái gì cũng có mặt trái của nó nên mình nói bạn tham khảo ý kiến chứ không nói bạn làm theo cách này. Theo mình việc mình cung cấp đủ các loại thép rồi thì không có gì bổ sung, nếu thêm 1 vài thanh thép nữa thì ta cập nhật tiếp chẳng sao
3.2. Để khắc phục đặt nhiều Button bạn có thể dùng MultiPage

Việc tạo ListBox các hình mình đã có ý tưởng nhưng chưa làm được

nguyenkhoadng · 2/12/12

viehoai đã viết:
1. Ban thay đổi Caption của Excel và file khi mở tạo menu TKTE2012 mà khi thoát Excel không trở lại tên mặt định và menu đó không xóa
2. Bạn dùng công thức này ở cột C sheet DuLieuThepTron =COUNTA(INDIRECT("C16:C" & ROW()-1))+1
3.

3.1. Cái gì cũng có mặt trái của nó nên mình nói bạn tham khảo ý kiến chứ không nói bạn làm theo cách này. Theo mình việc mình cung cấp đủ các loại thép rồi thì không có gì bổ sung, nếu thêm 1 vài thanh thép nữa thì ta cập nhật tiếp chẳng sao
3.2. Để khắc phục đặt nhiều Button bạn có thể dùng MultiPage
View attachment 93265
Việc tạo ListBox các hình mình đã có ý tưởng nhưng chưa làm được

Đã sửa và gửi a xem lại.
Chủ nhật vui vẻ!

nguyenkhoadng · 2/12/12

viehoai đã viết:
Đầu tiên bạn xóa đối tượng trong dòng rồi xóa dòng sau
Để xóa đối tượng trong dòng đó bạn sử dụng code

Mã:

For i = 1 To ActiveSheet.Shapes.Count If ActiveCell.Top <= ActiveSheet.Shapes(i).Top And ActiveCell.Offset(1).Top >= ActiveSheet.Shapes(i).Top _ And ActiveSheet.Shapes(i).Left < Range("P" & ActiveCell.Row).Left Then Sheet2.Shapes(i).Delete End If Next

Còn việc xóa dòng chắc bạn đã biết

Làm 1 lúc thì phát hiện ra đoạn code này chỉ xóa được hình ở dòng mình chọn thôi, còn khi e chọn nhiều hơn 1 dòng thì nó cũng chỉ xóa được hình của dòng chọn đầu tiên, mấy dòng được chọn khác ko bị xóa.
e mò 1 lúc vẫn ko ra nên phải chỉnh đoạn code này như thế nào nhờ a giúp.
e cảm ơn!

viehoai · 3/12/12

nguyenkhoadng đã viết:
Làm 1 lúc thì phát hiện ra đoạn code này chỉ xóa được hình ở dòng mình chọn thôi, còn khi e chọn nhiều hơn 1 dòng thì nó cũng chỉ xóa được hình của dòng chọn đầu tiên, mấy dòng được chọn khác ko bị xóa.
e mò 1 lúc vẫn ko ra nên phải chỉnh đoạn code này như thế nào nhờ a giúp.
e cảm ơn!

Mình mới đọc làm luôn, chưa test bạn test code sau thử nhé
[GPECODE=vb]For i = 1 To ActiveSheet.Shapes.Count
If Selection.Cells(1, 1).Top <= ActiveSheet.Shapes(i).Top And Selection.Cells(Selection.Row+1, 1).Offset(1).Top >= ActiveSheet.Shapes(i).Top Then
Sheet2.Shapes(i).Delete
End If
Next[/GPECODE]

nguyenkhoadng · 3/12/12

viehoai đã viết:
Mình mới đọc làm luôn, chưa test bạn test code sau thử nhé

Mã:

For i = 1 To ActiveSheet.Shapes.Count If Selection.Cells(1, 1).Top <= ActiveSheet.Shapes(i).Top And Selection.Cells(Selection.Row+1, 1).Offset(1).Top >= ActiveSheet.Shapes(i).Top Then Sheet2.Shapes(i).Delete End If Next

nó xóa xen kẽ a ah

ví dụ chọn 4 dòng thì dòng 1 và 3 sẽ xóa, dòng 2 và 4 ko xóa.

viehoai · 3/12/12

nguyenkhoadng đã viết:
nó xóa xen kẽ a ah
ví dụ chọn 4 dòng thì dòng 1 và 3 sẽ xóa, dòng 2 và 4 ko xóa.

Mình đã Test code này được

Mã:

For i = 1 To ActiveSheet.Shapes.CountIf Selection.Cells(1, 1).Top <= ActiveSheet.Shapes(i).Top And Selection.Cells(Selection.Rows.Count, 1).Offset(1).Top >= ActiveSheet.Shapes(i).Top Then
   ActiveSheet.Shapes(i).Delete
End If
Next

Hic, ăn cơm rồi tính tiếp

nguyenkhoadng · 3/12/12

viehoai đã viết:
Mình đã Test code này được

Mã:

For i = 1 To ActiveSheet.Shapes.CountIf Selection.Cells(1, 1).Top <= ActiveSheet.Shapes(i).Top And Selection.Cells(Selection.Rows.Count, 1).Offset(1).Top >= ActiveSheet.Shapes(i).Top Then ActiveSheet.Shapes(i).Delete End If Next

Hic, ăn cơm rồi tính tiếp

Vẫn xen kẽ a ơi.

file đính kèm...

Ăn cơm vui vẻ!

viehoai · 3/12/12

nguyenkhoadng đã viết:
Vẫn xen kẽ a ơi.
file đính kèm...

Ăn cơm vui vẻ!

Bạn thử với code này xem sao nhé

Mã:

Sub XoaHinh()
Dim Sh As Shape
Dim Rng As Range
Set Rng = Selection
For Each Sh In Sheet1.Shapes
If Rng.Cells(1, 1).Top <= Sh.Top And Rng.Cells(Rng.Rows.Count + 1, 1).Top >= Sh.Top Then
   Sh.Delete
End If
Next
End Sub

nguyenkhoadng · 3/12/12

viehoai đã viết:
Bạn thử với code này xem sao nhé

Mã:

Sub XoaHinh() Dim Sh As Shape Dim Rng As Range Set Rng = Selection For Each Sh In Sheet1.Shapes If Rng.Cells(1, 1).Top <= Sh.Top And Rng.Cells(Rng.Rows.Count + 1, 1).Top >= Sh.Top Then Sh.Delete End If Next End Sub

đoạn code này còn thiếu 1 chút nữa là hoàn chỉnh đó a ah.
đoạn code giải quyết đc yêu cầu xóa hình ở những dòng chọn liên tiếp nhau, còn nếu chọn những dòng cách nhau (nhấn ctrl và click chọn dòng) thì cũng chỉ xóa được hình ở những dòng chọn đầu tiên, những dòng mà mình nhấn ctrl để chọn sau thì ko xóa được.
Xóa hình khó thật, như xóa dữ liệu số và chữ khỏe re

nguyenkhoadng · 6/12/12

Mã:

[COLOR=#000000][I]Sub XoaHinh()[/I][/COLOR]
Dim Sh As Shape
Dim Rng As Range
Set Rng = Selection
For Each Sh In Sheet1.Shapes
If Rng.Cells(1, 1).Top <= Sh.Top And Rng.Cells(Rng.Rows.Count + 1, 1).Top >= Sh.Top Then
Sh.Delete
End If
Next 
[COLOR=#000000][I]End Sub
[/I][/COLOR]

Đoạn code trên được a viehoai viết, nhưng mấy ngày hôm nay ko thấy a viehoai online.
Nay e up lên nhờ các a, a nào có thể chỉnh lại giúp e đoạn code này với.

Ví dụ:
1. e chọn các dòng 1,2,5,8,9 thì khi dùng đoạn code này chỉ xóa đc hình ở dòng 1 và 2, còn các dòng còn lại ko xóa đc.
2. e chọn các dòng liên tiếp nhau 1,2,3,4,5 thì khi dùng đoạn code này sẽ xóa hình tất cả các dòng đã chọn
Nhờ các a chỉnh lại giúp e.

Nhờ các a chỉnh giúp e sao cho đối với ví dụ 1 thì có thể xóa hết các hình trên dòng mình chọn, không nhất thiết các dòng đó phải liên tiếp nhau.
e cảm ơn trước!

viehoai · 10/12/12

nguyenkhoadng đã viết:
Mã:

[COLOR=#000000][I]Sub XoaHinh()[/I][/COLOR] Dim Sh As Shape Dim Rng As Range Set Rng = Selection For Each Sh In Sheet1.Shapes If Rng.Cells(1, 1).Top <= Sh.Top And Rng.Cells(Rng.Rows.Count + 1, 1).Top >= Sh.Top Then Sh.Delete End If Next [COLOR=#000000][I]End Sub [/I][/COLOR]

Đoạn code trên được a viehoai viết, nhưng mấy ngày hôm nay ko thấy a viehoai online.
Nay e up lên nhờ các a, a nào có thể chỉnh lại giúp e đoạn code này với.

Ví dụ:
1. e chọn các dòng 1,2,5,8,9 thì khi dùng đoạn code này chỉ xóa đc hình ở dòng 1 và 2, còn các dòng còn lại ko xóa đc.
2. e chọn các dòng liên tiếp nhau 1,2,3,4,5 thì khi dùng đoạn code này sẽ xóa hình tất cả các dòng đã chọn
Nhờ các a chỉnh lại giúp e.

Nhờ các a chỉnh giúp e sao cho đối với ví dụ 1 thì có thể xóa hết các hình trên dòng mình chọn, không nhất thiết các dòng đó phải liên tiếp nhau.
e cảm ơn trước!

Code xóa hình tại các hàng của các cells lựa chọn:

Mã:

Sub XoaHinh()Dim Shp As Shape
Dim Rng As Range, sRng As Range
On Error Resume Next
Set sRng = Selection
For Each Shp In Sheet1.Shapes
   For Each Rng In sRng
      If Rng.Top <= Shp.Top And Rng.Offset(1).Top >= Shp.Top Then
         Shp.Delete
      End If
   Next
Next
End Sub

Còn xóa các hàng trên bạn tự làm nhé

ndu96081631 · 10/12/12

viehoai đã viết:
Code xóa hình tại các hàng của các cells lựa chọn:

Mã:

Sub XoaHinh()Dim Shp As Shape Dim Rng As Range, sRng As Range On Error Resume Next Set sRng = Selection For Each Shp In Sheet1.Shapes [COLOR=#ff0000]For Each Rng In sRng[/COLOR] If Rng.Top <= Shp.Top And Rng.Offset(1).Top >= Shp.Top Then Shp.Delete End If Next Next End Sub

Còn xóa các hàng trên bạn tự làm nhé

Chổ màu đỏ tôi nghĩ bạn nên duyệt theo từng Area sẽ nhanh hơn là duyệt từng cell. Ví dụ người dùng chọn cell thành 3 vùng phân biệt (A1:A5, A7:A10, A15:A20) thì vòng lập duyệt qua Area sẽ đi đúng 3 lần lặp (thay vì 15 lần)

viehoai · 10/12/12

ndu96081631 đã viết:
Chổ màu đỏ tôi nghĩ bạn nên duyệt theo từng Area sẽ nhanh hơn là duyệt từng cell. Ví dụ người dùng chọn cell thành 3 vùng phân biệt (A1:A5, A7:A10, A15:A20) thì vòng lập duyệt qua Area sẽ đi đúng 3 lần lặp (thay vì 15 lần)

Sư Phụ nói rõ hơn về duyệt theo từng Area, em chưa biết duyệt theo area mà chỉ quen dùng theo cell

ndu96081631 · 10/12/12

viehoai đã viết:
Sư Phụ nói rõ hơn về duyệt theo từng Area, em chưa biết duyệt theo area mà chỉ quen dùng theo cell

Định gợi ý thế thôi chứ nếu tôi làm thì sẽ làm khác:

PHP:

Function ShapeRange(ByVal shtName As String, ByVal shpName As String) As Range
  Dim shp As Shape
  On Error Resume Next
  Application.Volatile
  With Sheets(shtName)
    Set shp = .Shapes(shpName)
    Set ShapeRange = Range(shp.TopLeftCell, shp.BottomRightCell)
  End With
End Function

PHP:

[php]
Sub XoaHinh2()
  Dim shp As Shape
  Dim rng As Range, rShpRng As Range
  On Error Resume Next
  Set rng = Selection
  For Each shp In Sheet1.Shapes
    Set rShpRng = ShapeRange(ActiveSheet.Name, shp.Name)
    If Not Intersect(rShpRng, rng) Is Nothing Then shp.Delete
  Next
End Sub

nguyenkhoadng · 10/12/12

Cảm ơn 2 a, nhưng sử dụng 2 đoạn code trên thế nào nhờ 2 a chỉ giúp e với.
e đặt vào modul nó báo lỗi.

ndu96081631 · 10/12/12

nguyenkhoadng đã viết:
Cảm ơn 2 a, nhưng sử dụng 2 đoạn code trên thế nào nhờ 2 a chỉ giúp e với.
e đặt vào modul nó báo lỗi.

Chỉ "đặt" vào module thôi thì mắc mớ gì báo lỗi? Trừ phi bạn có xài đến code! Mà code ấy cũng không thể nào lỗi được, trừ phi trong module ấy lại có 1 sub hoặc 1 Function trùng tên với tên với code của tôi

nguyenkhoadng · 10/12/12

ndu96081631 đã viết:
Chỉ "đặt" vào module thôi thì mắc mớ gì báo lỗi? Trừ phi bạn có xài đến code! Mà code ấy cũng không thể nào lỗi được, trừ phi trong module ấy lại có 1 sub hoặc 1 Function trùng tên với tên với code của tôi

sub và Function cùng đặt vào 1 modul hả a?

nguyenkhoadng · 11/12/12

ndu96081631 đã viết:

Định gợi ý thế thôi chứ nếu tôi làm thì sẽ làm khác:

PHP:

Function ShapeRange(ByVal shtName As String, ByVal shpName As String) As Range
  Dim shp As Shape
  On Error Resume Next
  Application.Volatile
  With Sheets(shtName)
    Set shp = .Shapes(shpName)
    Set ShapeRange = Range(shp.TopLeftCell, shp.BottomRightCell)
  End With
End Function

PHP:

[php]
Sub XoaHinh2()
  Dim shp As Shape
  Dim rng As Range, rShpRng As Range
  On Error Resume Next
  Set rng = Selection
  For Each shp In Sheet1.Shapes
    Set rShpRng = ShapeRange(ActiveSheet.Name, shp.Name)
    If Not Intersect(rShpRng, rng) Is Nothing Then shp.Delete
  Next
End Sub

e đã bỏ cả 2 đoạn code trên vào 1 modul. thực thi lệnh thì ko báo lỗi nữa, nhưng cũng ko xóa được hình trên dòng được chọn a ah.

viehoai · 11/12/12

nguyenkhoadng đã viết:
e đã bỏ cả 2 đoạn code trên vào 1 modul. thực thi lệnh thì ko báo lỗi nữa, nhưng cũng ko xóa được hình trên dòng được chọn a ah.

Nếu bạn dùng cách của mình thì thử với code
[GPECODE=vb]Sub XoaHinh()
Dim Shp As Shape
Dim rng As Range, sRng As Range
On Error Resume Next
Set sRng = Selection
For Each Shp In Sheet1.Shapes
For Each rng In sRng.Areas
If rng.Top <= Shp.Top And Cells(rng.Row + rng.Rows.Count, 1).Top >= Shp.Top Then
Shp.Delete
End If
Next
Next
End Sub
[/GPECODE]

nguyenkhoadng · 11/12/12

Code của a ở bài #50 và #58 đều chạy được cả. vậy ở code này có gì khác so với bài #50 ko a? e thấy có thêm Areas.
Ah với lại đoạn code này khi e thêm phần xóa từng dòng được lựa chọn ở dưới Next thì nó xóa hết toàn bộ bảng tính luôn a ah, ko biết sao lại bị vậy, a xem giúp với.

Mã:

Sub ModClear()
On Error Resume Next
Anser = MsgBox("Ban co chac xoa dong da chon khong ?", vbDefaultButton1 + vbYesNo, " Are you sure ?")
If Anser = vbYes Then
Dim Shp As Shape
Dim rng As Range, sRng As Range
On Error Resume Next
Set sRng = Selection
For Each Shp In ActiveSheet.Shapes
   For Each rng In sRng.Areas
      If rng.Top <= Shp.Top And Cells(rng.Row + rng.Rows.Count, 1).Top >= Shp.Top Then
         Shp.Delete
      End If
   Next
Next
        Selection.EntireRow.Select
        Selection.ClearContents
        ActiveCell.Offset(0, 2).Select
End If
End Sub

viehoai · 11/12/12

nguyenkhoadng đã viết:
Code của a ở bài #50 và #58 đều chạy được cả. vậy ở code này có gì khác so với bài #50 ko a? e thấy có thêm Areas.
Ah với lại đoạn code này khi e thêm phần xóa từng dòng được lựa chọn ở dưới Next thì nó xóa hết toàn bộ bảng tính luôn a ah, ko biết sao lại bị vậy, a xem giúp với.

Mã:

Sub ModClear() On Error Resume Next Anser = MsgBox("Ban co chac xoa dong da chon khong ?", vbDefaultButton1 + vbYesNo, " Are you sure ?") If Anser = vbYes Then Dim Shp As Shape Dim rng As Range, sRng As Range On Error Resume Next Set sRng = Selection For Each Shp In ActiveSheet.Shapes For Each rng In sRng.Areas If rng.Top <= Shp.Top And Cells(rng.Row + rng.Rows.Count, 1).Top >= Shp.Top Then Shp.Delete End If Next Next Selection.EntireRow.Select Selection.ClearContents ActiveCell.Offset(0, 2).Select End If End Sub

1. Code bài 58 khác bài 50 là theo góp ý của anh ndu bài 51
2. Code như thế này là đủ (nhưng bạn xóa dữ liệu chứ không xóa dòng??)

Mã:

Sub ModClear()
On Error Resume Next
Anser = MsgBox("Ban co chac xoa dong da chon khong ?", vbDefaultButton1 + vbYesNo, " Are you sure ?")
If Anser = vbYes Then
Dim Shp As Shape
Dim rng As Range, sRng As Range
On Error Resume Next
Set sRng = Selection
For Each Shp In ActiveSheet.Shapes
   For Each rng In sRng.Areas
      If rng.Top <= Shp.Top And Cells(rng.Row + rng.Rows.Count, 1).Top >= Shp.Top Then
         Shp.Delete
      End If
   Next
Next
        sRng.EntireRow.ClearContents
End If
End Sub

nguyenkhoadng · 11/12/12

viehoai đã viết:
1. Code bài 58 khác bài 50 là theo góp ý của anh ndu bài 51
2. Code như thế này là đủ (nhưng bạn xóa dữ liệu chứ không xóa dòng??)

1. đoạn code này khi e chưa chạy bảng tổng hợp thép thì nó xóa tốt, nhưng khi chạy bảng tổng hợp thép rồi thì nó chỉ xóa hình chứ dữ liệ ko bị xóa.
e gửi a 2 file (1 file chưa chạy bảng tổng hợp thép, 1 file đã chạy bảng tổng hợp thép) a thực hiện lệnh xóa dòng trên 2 file sẽ dễ hình dung hơn.
2. A có cách nào chèn công thức ở T8 và U8 vào trong code tổng hợp thép để khi chạy code tổng hợp nó mới hiện ra ko a? hiện e đang cho nó trực tiếp trên bảng tính nên rất bất tiện, lỡ khi xóa dòng 8 thì xem như bảng tổng hợp thép ko có kết quả.
Nhờ a xem giúp.

viehoai · 11/12/12

nguyenkhoadng đã viết:
1. đoạn code này khi e chưa chạy bảng tổng hợp thép thì nó xóa tốt, nhưng khi chạy bảng tổng hợp thép rồi thì nó chỉ xóa hình chứ dữ liệ ko bị xóa.
e gửi a 2 file (1 file chưa chạy bảng tổng hợp thép, 1 file đã chạy bảng tổng hợp thép) a thực hiện lệnh xóa dòng trên 2 file sẽ dễ hình dung hơn.
2. A có cách nào chèn công thức ở T8 và U8 vào trong code tổng hợp thép để khi chạy code tổng hợp nó mới hiện ra ko a? hiện e đang cho nó trực tiếp trên bảng tính nên rất bất tiện, lỡ khi xóa dòng 8 thì xem như bảng tổng hợp thép ko có kết quả.
Nhờ a xem giúp.

Bạn dùng với code có 2 trường hợp để bạn chọn
(nguyên nhân bảng tổng hợp có Merge)
[GPECODE=vb]
Sub ModClear()
On Error Resume Next
Anser = MsgBox("Ban co chac xoa dong da chon khong ?", vbDefaultButton1 + vbYesNo, " Are you sure ?")
If Anser = vbYes Then
Dim Shp As Shape
Dim rng As Range, sRng As Range
On Error Resume Next
Set sRng = Selection
For Each Shp In ActiveSheet.Shapes
For Each rng In sRng.Areas
If rng.Top <= Shp.Top And Cells(rng.Row + rng.Rows.Count, 1).Top >= Shp.Top Then
Shp.Delete
End If
'Truong hop chi xoa du lieu
With rng
.Offset(, -.Column + 1).Resize(, 17).ClearContents
End With
'Truong hop xoa hang
'With rng
' .Offset(, -.Column + 1).Resize(, 17).Delete Shift:=xlUp
'End With
Next
Next
End If
End Sub
[/GPECODE]
Vấn đề công thức bảng tổng hợp mình chưa hiểu ý bạn

nguyenkhoadng · 11/12/12

viehoai đã viết:
Vấn đề công thức bảng tổng hợp mình chưa hiểu ý bạn

A xem khi mở file "CHUA-chay-bang-tong-hop-thep" ở ô T8 và U8 có 2 công thức để khi chạy bảng tổng hợp thì sẽ tự động copy 2 công thức này xuống các hàng dưới.
nhưng như vậy thì nếu lỡ người dùng xóa 2 công thức này thì xem như bảng tổng hợp ko có kết quả.
ý e muốn nhờ a đưa luôn 2 công thức này vào trong code tổng hợp thép (nghĩa là khi mở bảng tính này sẽ ko còn nhìn thấy 2 công thức ở ô T8 và U8 nữa).

nguyenkhoadng · 11/12/12

viehoai đã viết:

Mã:

Sub ModClear()
On Error Resume Next
Anser = MsgBox("Ban co chac xoa dong da chon khong ?", vbDefaultButton1 + vbYesNo, " Are you sure ?")
If Anser = vbYes Then
Dim Shp As Shape
Dim rng As Range, sRng As Range
On Error Resume Next
Set sRng = Selection
For Each Shp In ActiveSheet.Shapes
   For Each rng In sRng.Areas
      If rng.Top <= Shp.Top And Cells(rng.Row + rng.Rows.Count, 1).Top >= Shp.Top Then
         Shp.Delete
      End If
   'Truong hop chi xoa du lieu
      With rng
         .Offset(, -.Column + 1).Resize(, 17).ClearContents
      End With
[COLOR=#ff0000]    'Truong hop xoa hang
       'With rng
       '  .Offset(, -.Column + 1).Resize(, 17).Delete Shift:=xlUp
       'End With
[/COLOR]   Next
Next
End If
End Sub

Trường hợp xóa hàng này thì hình ở những dòng khác cũng bị xóa hết a ah.

viehoai · 11/12/12

nguyenkhoadng đã viết:
Trường hợp xóa hàng này thì hình ở những dòng khác cũng bị xóa hết a ah.

Trường hợp xóa dòng:
[GPECODE=vb]Sub ModClear()
On Error Resume Next
Anser = MsgBox("Ban co chac xoa dong da chon khong ?", vbDefaultButton1 + vbYesNo, " Are you sure ?")
If Anser = vbYes Then
Dim Shp As Shape
Dim rng As Range, sRng As Range
On Error Resume Next
Set sRng = Selection
For Each Shp In ActiveSheet.Shapes
For Each rng In sRng.Areas
If rng.Top <= Shp.Top And Cells(rng.Row + rng.Rows.Count, 1).Top >= Shp.Top Then
Shp.Delete
End If
Next
Next
For Each rng In sRng.Areas
Range("A" & rng.Row).Resize(rng.Rows.Count, 17).Delete xlUp
Next
End If
End Sub[/GPECODE]

nguyenkhoadng · 11/12/12

Cảm ơn a, tất cả đều chạy tốt a ah

1. Khi nào a có thời gian nhờ a xem giúp e câu hỏi ở bài #63 với.
2. Còn 1 vấn đề nữa là công thức ở cột B e đang dùng "=IF(B9=0;1;B9)", khi xóa dữ liệu ở dòng bên trên thì công thức vẫn chạy tốt, nhưng khi cắt luôn dòng bên trên thì lại báo lỗi. vậy ở đâu mình nên thay bằng công thức nào cho phù hợp vậy a?
Tất cả có trong file đính kèm bài #63.
Em cảm ơn!

viehoai · 11/12/12

nguyenkhoadng đã viết:
Cảm ơn a, tất cả đều chạy tốt a ah
1. Khi nào a có thời gian nhờ a xem giúp e câu hỏi ở bài #63 với.
2. Còn 1 vấn đề nữa là công thức ở cột B e đang dùng "=IF(B9=0;1;B9)", khi xóa dữ liệu ở dòng bên trên thì công thức vẫn chạy tốt, nhưng khi cắt luôn dòng bên trên thì lại báo lỗi. vậy ở đâu mình nên thay bằng công thức nào cho phù hợp vậy a?
Tất cả có trong file đính kèm bài #63.
Em cảm ơn!

Mình giúp bạn code tổng hợp thép luôn
[GPECODE=vb]
Sub TongHopThep()
Dim Dic, Arr(), Tmp(), ArrKQ()
Dim eRw As Long, k As Long, i As Long
Range("S8:X21").Delete xlUp
eRw = ActiveSheet.Range("I65500").End(3).Row
If eRw < 8 Then Exit Sub
Arr = Range("I8

" & eRw).Value
ReDim ArrKQ(1 To UBound(Arr) + 1, 1 To 6)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Arr(i, 1) <> "" And Not Dic.Exists(Arr(i, 1)) Then
Dic.Add Arr(i, 1), ""
k = k + 1
ArrKQ(k, 2) = "=SUMIF(R[" & 1 - k & "]C[-11]:R[" & eRw - k - 7 & "]C[-11], RC[-1],R[" & 1 - k & "]C[-6]:R[" & eRw - k - 7 & "]C[-6])"
ArrKQ(k, 3) = "=SUMIF(R[" & 1 - k & "]C[-12]:R[" & eRw - k - 7 & "]C[-12], RC[-2],R[" & 1 - k & "]C[-5]:R[" & eRw - k - 7 & "]C[-5])"
End If
Next
Tmp = Dic.keys
For i = 0 To Dic.Count - 1
ArrKQ(i + 1, 1) = Tmp(i)
Next
ArrKQ(k + 1, 3) = "=SUM(R[" & -k & "]C:R[-1]C)"
ArrKQ(k + 1, 1) = "T" & ChrW(7892) & "NG TR" & ChrW(7884) & "NG L" & ChrW(431) & ChrW(7906) & "NG"

ArrKQ(1, 4) = "=SUMIF(RC[-3]:R[" & k - 1 & "]C[-3],""<=10"",RC[-1]:R[" & k - 1 & "]C[-1])"
ArrKQ(1, 5) = "=R[" & k & "]C[-2]-RC[-1]-RC[1]"
ArrKQ(1, 6) = "=SUMIF(RC[-5]:R[" & k - 1 & "]C[-5],"">18"",RC[-3]:R[" & k - 1 & "]C[-3])"
Range("S8").Resize(k + 1, 6).Value = ArrKQ
Range("S8").Resize(k).Sort Key1:=Range("S8"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, Orientation:=xlTopToBottom
With Range("V8:V" & k + 8)
.Offset(, 1).Merge
.Offset(, 2).Merge
.Resize(, 3).Font.Bold = True
.Merge
End With
With Range("S" & k + 8).Resize(, 2)
.Resize(, 3).Font.Bold = True
.Merge
End With
With Range("S8:X" & k + 8).Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
End Sub[/GPECODE]
Còn công thức ở cột B mình đã giúp bạn công thức COUNTA() rồi mà Bài #40

nguyenkhoadng · 11/12/12

viehoai đã viết:
Còn công thức ở cột B mình đã giúp bạn công thức COUNTA() rồi mà Bài #40

hàm COUNTA() dùng để đếm nên với cột C (Đánh số hiệu) thì dùng công thức của a giúp e ở bái #40.
Còn với cột B có nội dung là nếu giá trị ô bên trên bằng 0 thì lấy =1, còn ko thì lấy giá trị ô bên trên, thì e dùng hàm counta nó ko theo ý muốn. nó vẫn cho giá trị tăng dần.

viehoai · 11/12/12

nguyenkhoadng đã viết:
hàm COUNTA() dùng để đếm nên với cột C (Đánh số hiệu) thì dùng công thức của a giúp e ở bái #40.
Còn với cột B có nội dung là nếu giá trị ô bên trên bằng 0 thì lấy =1, còn ko thì lấy giá trị ô bên trên, thì e dùng hàm counta nó ko theo ý muốn. nó vẫn cho giá trị tăng dần.

Bạn xem file rồi thay đổi như thế nào phù hợp với mình

nguyenkhoadng · 11/12/12

viehoai đã viết:
Bạn xem file rồi thay đổi như thế nào phù hợp với mình

Hàm counta này hình như nó chỉ đếm số ô có giá trị thôi thì phải, nó được cái xóa dòng trên thì ko bị báo lỗi. e làm thế nào cũng ko thể cho nó lấy giá trị ô bên trên nếu ô bên trên khác 0.

Tạm thời e sử dụng hàm if, hơi mất công lúc xóa dòng chút. để tìm hiểu hàm counta sau vậy a

Cảm ơn a đã giúp e nhiều.
cuối cùng e đã có 1 Add-in thống kê ưng ý rồi. excel thật là tuyệt, có điều kiện sẽ học hỏi thêm nhiều.
e cảm ơn và chúc a vui vẻ!

Sửa code để hoàn thiện file thống kê thép. (1 người xem)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

File đính kèm

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

File đính kèm

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

Thành viên gắn bó

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

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

Thành viên gắn bó

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

Thành viên gắn bó

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

File đính kèm

Thành viên gắn bó

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

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

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

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

Huyền thoại GPE

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

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

Thành viên gắn bó

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

Thành viên gắn bó

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

File đính kèm

Thành viên gắn bó

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

File đính kèm

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

File đính kèm

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