Code thêm các dòng chữ phía dưỡi bảng tính. (1 người xem)

[nguyenkhoadng]

Em có đoạn code như bên dưới, nhưng nó chạy không như ý muốn.
Ý của em là muốn cho các dòng chữ diễn giải chi tiết xuất hiện theo từng loại thép khác nhau,
đây là đoạn code

Sub TONG()
    For i = 1 To ActiveSheet.Range("AC1").Value
    ActiveSheet.Range("A" & ActiveSheet.Range("AB1").Value + i) = " - Tong trong luong thep co duong kinh " & Range("U11") & " mm la: " & Round(Range("W11"), 2) & " kg. Chieu dai la: " & Round(Range("V11"), 2) & " m."
    Next i
End Sub

Em gửi thêm file đính kèm để các anh tiện giúp.
Em cảm ơn!

 

[mhung12005]

Em có đoạn code như bên dưới, nhưng nó chạy không như ý muốn.
Ý của em là muốn cho các dòng chữ diễn giải chi tiết xuất hiện theo từng loại thép khác nhau,
đây là đoạn code

Sub TONG()
    For i = 1 To ActiveSheet.Range("AC1").Value
    ActiveSheet.Range("A" & ActiveSheet.Range("AB1").Value + i) = " - Tong trong luong thep co duong kinh " & Range("U11") & " mm la: " & Round(Range("W11"), 2) & " kg. Chieu dai la: " & Round(Range("V11"), 2) & " m."
    Next i
End Sub

Em gửi thêm file đính kèm để các anh tiện giúp.
Em cảm ơn!

Bạn thử cái này xem

Sub TONG()    
    Dim rRng As Range
    Dim i As Long, lTagRow As Long
    
    Set rRng = Sheet4.Range("U11:W15")
    lTagRow = Sheet4.Range("AB1").Value
    For i = 1 To rRng.Rows.Count
        Sheet4.Cells(lTagRow + i, 1) = " - Tong trong luong thep co duong kinh " & rRng(i, 1) & " mm la: " & Round(rRng(i, 3), 1) & " kg. Chieu dai la: " & Round(rRng(i, 2), 1) & " m."
    Next i
    
End Sub

 

[nguyenkhoadng]

Cảm ơn anh!

Các anh cho em hỏi thêm 2 vấn đề liên quan đến đoạn code trên nữa:
1. Vùng "U11:W15" đang bị gới hạn, nếu trong bảng có nhiều chủng loại hơn (Nghĩa là số dòng nhiều hơn dòng 15) thì code không chạy đúng?
2. Em muốn nhờ bỏ các ô phụ (ô AB1, AC1) để đưa vào khai báo trong code luôn cho gọn bảng tính.

Em cảm ơn!

 

[Let'GâuGâu]

Cảm ơn anh!

Các anh cho em hỏi thêm 2 vấn đề liên quan đến đoạn code trên nữa:
1. Vùng "U11:W15" đang bị gới hạn, nếu trong bảng có nhiều chủng loại hơn (Nghĩa là số dòng nhiều hơn dòng 15) thì code không chạy đúng?
2. Em muốn nhờ bỏ các ô phụ (ô AB1, AC1) để đưa vào khai báo trong code luôn cho gọn bảng tính.

Em cảm ơn!

chưa có sắp xếp được từ lớn đến bé

Sub TONG()
    Dim sarr, tam, tam1 As Variant, cd(), tl(), kq(), i, j, k As Long, dic As Object
    
    er = [i60000].End(3).Row
    sarr = [i11].Resize(er, 10).Value
    Set dic = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(sarr)
    If Not dic.exists(sarr(i, 1)) Then
        k = k + 1
        dic.Add sarr(i, 1), k
        ReDim Preserve cd(1 To k)
        cd(k) = sarr(i, 8)
        ReDim Preserve tl(1 To k)
        tl(k) = sarr(i, 10)
        
    Else
        cd(dic.Item(sarr(i, 1))) = cd(dic.Item(sarr(i, 1))) + sarr(i, 8)
        tl(dic.Item(sarr(i, 1))) = tl(dic.Item(sarr(i, 1))) + sarr(i, 10)
    End If
    Next
   
If k Then
ReDim kq(1 To k, 1 To 2)
For i = 1 To k - 1
      kq(i, 1) = "- Tong trong luong thep co duong kinh " & dic.Keys()(i - 1) & " mm la " & Round(tl(i), 0) & ". Chieu dai la: " & cd(i)
        kq(i, 2) = dic.Keys()(i - 1)
Next
For i = 1 To k - 1
    For j = i + 1 To k - 1
      If kq(i, 2) > kq(j, 2) Then
        tam = kq(j, 2)
        tam1 = kq(j, 1)
        kq(j, 1) = kq(i, 1)
        kq(j, 2) = kq(i, 2)
        kq(i, 2) = tam
        kq(i, 1) = tam1
      End If
    Next j
  Next i
[a1].Offset(er + 1).Resize(k).Value = kq
End If

Set dic = Nothing
Erase sarr, tl, cd, kq
End Sub

 

[nguyenkhoadng]

Đoạn code anh giúp vẫn chưa được anh ơi.

 

[Let'GâuGâu]

Đoạn code anh giúp vẫn chưa được anh ơi.

hehe tui làm lộn, tui tưởng vùng dữ liệu của bạn là cột I đế cột R
vì vậy mới mất công sort lại
hihihhihhi

 

[Let'GâuGâu]

Đoạn code anh giúp vẫn chưa được anh ơi.

đây code cho vùng dữ liệu từ cột U đến cột W

Sub TONG()
    Dim sarr As Variant, kq(), i, j, k As Long
    sarr = [u11].Resize([u60000].End(3).Row - 11, 3).Value
    ReDim kq(1 To UBound(sarr), 1 To 1)
    For i = 1 To UBound(sarr)
        kq(i, 1) = "- Tong trong luong thep co duong kinh " & sarr(i, 1) & " mm la " & Round(sarr(i, 3), 0) & "kg. Chieu dai la: " & Round(sarr(i, 2), 1)
    
    Next
[a1].Offset([b60000].End(3).Row + 2).Resize(i - 1).Value = kq
End Sub

 

[nguyenkhoadng]

đây code cho vùng dữ liệu từ cột U đến cột W

Sub TONG()
    Dim sarr As Variant, kq(), i, j, k As Long
    sarr = [u11].Resize([u60000].End(3).Row - 11, 3).Value
    ReDim kq(1 To UBound(sarr), 1 To 1)
    For i = 1 To UBound(sarr)
        kq(i, 1) = "- Tong trong luong thep co duong kinh " & sarr(i, 1) & " mm la " & Round(sarr(i, 3), 0) & "kg. Chieu dai la: " & Round(sarr(i, 2), 1)
    
    Next
[a1].Offset([b60000].End(3).Row + 2).Resize(i - 1).Value = kq
End Sub

Code hoạt động tốt anh ah
Nhờ các anh giúp em thêm 1 đoạn code để xóa các dòng "- Tong trong luong thep co duong kinh ..." vừa được tạo ra bởi đoạn code trên.
ở đây chỉ xóa các dòng chữ đó thôi, hoặc xóa từ vùng cột A đến cột S. chứ không phải xóa nguyên dòng, vì nếu xóa nguyên dòng nhiều lúc xóa luôn số liệu bên vùng từ cột U đến cột Z.
Em cảm ơn!

 

[Let'GâuGâu]

Code hoạt động tốt anh ah
Nhờ các anh giúp em thêm 1 đoạn code để xóa các dòng "- Tong trong luong thep co duong kinh ..." vừa được tạo ra bởi đoạn code trên.
ở đây chỉ xóa các dòng chữ đó thôi, hoặc xóa từ vùng cột A đến cột S. chứ không phải xóa nguyên dòng, vì nếu xóa nguyên dòng nhiều lúc xóa luôn số liệu bên vùng từ cột U đến cột Z.
Em cảm ơn!

Sub TONG()
    Dim sarr As Variant, kq(), i, j, k As Long
    sarr = [u11].Resize([u60000].End(3).Row - 11, 3).Value
    ReDim kq(1 To UBound(sarr), 1 To 1)
    For i = 1 To UBound(sarr)
        kq(i, 1) = "- Tong trong luong thep co duong kinh " & sarr(i, 1) & " mm la " & Round(sarr(i, 3), 0) & "kg. Chieu dai la: " & Round(sarr(i, 2), 1)
    
    Next
[COLOR=#0000ff][a1].Offset([b60000].End(3).Row + 2).Resize(i - 1).clearcontent[/COLOR]
[a1].Offset([b60000].End(3).Row + 2).Resize(i - 1).Value = kq
End Sub

 

[nguyenkhoadng]

Cảm ơn anh!

ở đây em muốn tạo 1 sub riêng, ko nằm chung với sub TONG.
dựa vào code anh giúp em tạo thành sub để xóa các dòng vừa tạo như bên dưới, em dùng thử vẫn ổn, nhờ anh xem thử được chưa hay cần sử gì không?

Sub xoa()
Dim sarr As Variant
Dim p As Long
    sarr = [u11].Resize([u60000].End(3).Row - 11, 3).Value
    For p = 1 To UBound(sarr)
    Next
[b1].Offset([c60000].End(3).Row + 1).Resize(p - 1).ClearContents
End Sub

 

[Let'GâuGâu]

Cảm ơn anh!

ở đây em muốn tạo 1 sub riêng, ko nằm chung với sub TONG.
dựa vào code anh giúp em tạo thành sub để xóa các dòng vừa tạo như bên dưới, em dùng thử vẫn ổn, nhờ anh xem thử được chưa hay cần sử gì không?[/CODE]

Sub xoa()
Dim sarr As Variant
Dim p As Long
    sarr = [u11].Resize([u60000].End(3).Row - 11, 3).Value ' khai bao nguon cho mang
    For p = 1 To UBound(sarr) ' vòng lap
    Next
[COLOR=#ff0000][b1].Offset([c60000].End(3).Row + 1).Resize(p - 1).ClearContents[/COLOR] 'lenh xoa
End Sub

bạn chỉ cần giữ lại dòng màu đỏ là được