Tự động đánh stt khi tách dòng

Liên hệ QC

tampt@stonevietnam

Thành viên mới
Tham gia
15/4/15
Bài viết
49
Được thích
2
Gửi các anh chị

Các anh chị hỗ trợ giúp em viết giúp em đoạn VBA khi tách dòng thì tự động đánh STT theo hạng mục ở cột A giúp em với ạ

Hiện tại file em gửi phía dưới em đã tách được dòng tự động được rồi tuy nhiên khi tách thì ko đánh đc stt theo cột A

Anh chị giúp đỡ em với ạ
Em cám ơn anh chị
 

File đính kèm

  • TU DONG DANH STT KHI TACH DONG.xls
    38.5 KB · Đọc: 28
Gửi các anh chị

Các anh chị hỗ trợ giúp em viết giúp em đoạn VBA khi tách dòng thì tự động đánh STT theo hạng mục ở cột A giúp em với ạ

Hiện tại file em gửi phía dưới em đã tách được dòng tự động được rồi tuy nhiên khi tách thì ko đánh đc stt theo cột A

Anh chị giúp đỡ em với ạ
Em cám ơn anh chị
Thay dòng code cuối cùng, dòng này:
Mã:
lr = [a4].End(xlDown).Row
Bằng dòng này:
Mã:
Call DanhsoTT
Và thêm sub sau vào Module:
Mã:
Sub DanhsoTT()
    Dim DongCuoi As Long
    DongCuoi = Range("A" & Rows.Count).End(xlUp).Row
    Range("M4") = 1
    Range("M5") = Range("M4") + 1
    Range("M4:M5").AutoFill Destination:=Range("M4:M" & DongCuoi)
End Sub
 
Lần chỉnh sửa cuối:
Mình cám ơn be09 nhé
Tuy nhiên sau khi thêm dòng lệnh vào thì hiện hế này ạ
và ko in được ạ
Bạn xem giúp mình với
1540000181223.png
 
Gửi các anh chị

Các anh chị hỗ trợ giúp em viết giúp em đoạn VBA khi tách dòng thì tự động đánh STT theo hạng mục ở cột A giúp em với ạ

Hiện tại file em gửi phía dưới em đã tách được dòng tự động được rồi tuy nhiên khi tách thì ko đánh đc stt theo cột A

Anh chị giúp đỡ em với ạ
Em cám ơn anh chị
Sau thằng Next bạn nhập em này:
Mã:
Next
    Range([L4], [L4].End(xlDown)).Offset(, 1) = [row(A:A)]
 End Sub
Code này bạn nên thêm
Mã:
Application.ScreenUpdating = False
Application.ScreenUpdating = True
ở đầu và cuối code để khi chạy nó khỏi "cà giựt"
Nếu số lượng nhiều nên dùng mảng sẽ chạy nhanh hơn
Thân
 
sau cái Call DanhsoTT bạn Enter xuống và viết End Sub nhé
1540019551681.png
Bài đã được tự động gộp:

Gíup em với ạ. em cần lắm các cao nhân
Bài đã được tự động gộp:

Em thêm đoạn CODE này vào nhưng khi ấn lệnh thì nó ko chạy ạ
1540020050790.png
 
Lần chỉnh sửa cuối:
@tampt@stonevietnam: Bạn nên học hay tự học lại VBA cơ bản, không thì ai giúp cũng thế (vì không hiểu như nhắm mắt mà chạy)
 
@tampt@stonevietnam: Bạn nên học hay tự học lại VBA cơ bản, không thì ai giúp cũng thế (vì không hiểu như nhắm mắt mà chạy)
Cám ơn những góp ý chân thành của bạn, Minh cũng đang học hỏi từ các bạn thông qua các bài mình làm thực tế mà. Sự giúp đỡ của các bạn là niềm hạnh phúc của mình,
 
Gửi các anh chị

Các anh chị hỗ trợ giúp em viết giúp em đoạn VBA khi tách dòng thì tự động đánh STT theo hạng mục ở cột A giúp em với ạ

Hiện tại file em gửi phía dưới em đã tách được dòng tự động được rồi tuy nhiên khi tách thì ko đánh đc stt theo cột A

Anh chị giúp đỡ em với ạ
Em cám ơn anh chị
Mã:
Sub Tach_HD()
Dim sArr(), i As Long, j As Long, dArr(1 To 10000, 1 To 13), k As Long, sh As Worksheet

Set sh = Sheets("Sheet1") 'khi can thi doi ten sheet trong dau nhay

sArr = sh.Range("A4", sh.[A65536].End(3)).Resize(, 12).Value

For i = 1 To UBound(sArr)
   For n = 1 To sArr(i, 12)
      k = k + 1
      For j = 1 To UBound(sArr, 2)
         dArr(k, j) = sArr(i, j)
      Next
      dArr(k, 13) = i
   Next
Next

sh.[A4].Resize(k, UBound(dArr, 2)) = dArr
End Sub
 
Mã:
Sub Tach_HD()
Dim sArr(), i As Long, j As Long, dArr(1 To 10000, 1 To 13), k As Long, sh As Worksheet

Set sh = Sheets("Sheet1") 'khi can thi doi ten sheet trong dau nhay

sArr = sh.Range("A4", sh.[A65536].End(3)).Resize(, 12).Value

For i = 1 To UBound(sArr)
   For n = 1 To sArr(i, 12)
      k = k + 1
      For j = 1 To UBound(sArr, 2)
         dArr(k, j) = sArr(i, j)
      Next
      dArr(k, 13) = i
   Next
Next

sh.[A4].Resize(k, UBound(dArr, 2)) = dArr
End Sub
Mình các ơn cậu
sau khi thêm đoạn vba vào thì STT có nhảy nhưng mình mong muốn stt nhảy lần lượt từ 1-N dựa trên cơ sở cột A để nhảy

Theo như hình dưới này . cậu giúp mình với

Thanks câuj

1540177601468.png
 
Mình các ơn cậu
sau khi thêm đoạn vba vào thì STT có nhảy nhưng mình mong muốn stt nhảy lần lượt từ 1-N dựa trên cơ sở cột A để nhảy

Theo như hình dưới này . cậu giúp mình với

Cảm ơn câuj

View attachment 206119
Mình không hiểu quy luật tại dòng 14 nên không sửa code như bạn muốn được. Xài tạm thế này
Mã:
Sub Tach_HD()
Dim sArr(), i As Long, j As Long, dArr(1 To 10000, 1 To 13), k As Long, sh As Worksheet

Set sh = Sheets("Sheet1") 'khi can thi doi ten sheet trong dau nhay

sArr = sh.Range("A4", sh.[A65536].End(3)).Resize(, 12).Value

For i = 1 To UBound(sArr)
   For n = 1 To sArr(i, 12)
      k = k + 1
      For j = 1 To UBound(sArr, 2)
         dArr(k, j) = sArr(i, j)
      Next
      dArr(k, 13) = n
   Next
Next

sh.[A4].Resize(k, UBound(dArr, 2)) = dArr
End Sub
 
Mình các ơn cậu
sau khi thêm đoạn vba vào thì STT có nhảy nhưng mình mong muốn stt nhảy lần lượt từ 1-N dựa trên cơ sở cột A để nhảy

Theo như hình dưới này . cậu giúp mình với

Cảm ơn câuj

View attachment 206119
Mã:
Sub GPE()
  Dim sArr(), Res()
  Dim i As Long, k As Long, n As Long, q As Long, stt As Long, j As Byte, sRow As Long, sCol As Byte
  With Sheets("Sheet1")
    i = .Range("A65500").End(xlUp).Row
    If i < 4 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:L" & i).Value
    sRow = Application.Sum(.Range("D4:D" & i))
  End With
  sCol = UBound(sArr, 2)
  ReDim Res(1 To sRow, 1 To sCol + 1)
  For i = 2 To UBound(sArr)
    stt = 1
    For j = 1 To sCol
      If sArr(i, j) <> sArr(i - 1, j) Then stt = 0: Exit For
    Next j
    If stt = 1 Then stt = Res(k, sCol + 1)
    n = sArr(i, 4)
    For q = 1 To n
      k = k + 1
      For j = 1 To sCol
        If j = 4 Then Res(k, j) = 1 Else Res(k, j) = sArr(i, j)
      Next j
      Res(k, sCol + 1) = stt + q
    Next q
  Next i
  Sheets("Sheet1").Range("A4:M4").Resize(sRow) = Res
End Sub
 

File đính kèm

  • Xang pha nhot 22-10.xls
    52.5 KB · Đọc: 8
Dạ em cám ơn các anh/ chị đã nhiệt tình giúp đỡ em trong bài tập vừa rồi .
Em đã làm được nhờ sự giúp đỡ và viết VBA của Bác khi ta 20
Chúc anh chị 1 ngày làm việc hiệu quả ạ
 
Web KT
Back
Top Bottom