Giúp code chuyển sang dạng mãng tạo Số thứ tự

[hunglam123]

Em chào các anh chị. Hiện em cần tạo 1 dãy số thứ tự tăng dần theo ( Mã, Từ, Đến )
- Khi em thay đổi Mã, từ ,đến thì bấm vào nút bấm sẽ chạy ra hết ở cột G
- Hiện Cái này em làm được công thức mà nó chậm bảng tính quá. Nhờ mọi người viết bằng Sub dạng mãng cho nhanh. để em gắn vào nút bấm em xin cảm ơn ạ

 

[VetMini]

Cái này có người hỏi rồi.
Mà cách hỏi, cách tô màu phông chữ và ô bảng tính cũng in hệt nữa.
Chịu khó tìm.

 

[VuVanHao]

Không biết nhanh hay không, bạn thử xem

Private Sub CommandButton1_Click()
Dim i, k, a, b As Long
Dim Arr()
Dim str As String
With Sheet1
    a = .Range("C4").Value
    b = .Range("D4").Value
    str = .Range("B4").Value
End With
ReDim Arr(1 To b - a + 1, 1 To 1)
For i = a To b
k = k + 1
    Arr(k, 1) = str & i
Next i
Sheet1.Range("G4").Resize(b - a + 1, 1).Value = Arr
End Sub

 

[hunglam123]

Không biết nhanh hay không, bạn thử xem

Private Sub CommandButton1_Click()
Dim i, k, a, b As Long
Dim Arr()
Dim str As String
With Sheet1
    a = .Range("C4").Value
    b = .Range("D4").Value
    str = .Range("B4").Value
End With
ReDim Arr(1 To b - a + 1, 1 To 1)
For i = a To b
k = k + 1
    Arr(k, 1) = str & i
Next i
Sheet1.Range("G4").Resize(b - a + 1, 1).Value = Arr
End Sub

Code rất nhanh. Cảm ơn bạn nhiều

 Sub tachdulieu()
             On Error Resume Next
            Dim i, k, a, b, c As Long
            Dim Arr()
            Dim str As String
            
                a = Range("C4").Value ' ma
                b = Range("D4").Value ' tu
                str = Range("B4").Value ' den
                c = b - a + 1
            
            ReDim Arr(1 To c, 1 To 1)
            For i = a To b
            k = k + 1
                Arr(k, 1) = str & i
            Next i
            Range("G4:G1000000").ClearContents
            Range("G4").Resize(c, 1).Value = Arr ' ouput
End Sub

 

[PacificPR]

Chủ Topic thử ... thử hàm tạo mã này xem
=TaoMa(A3;B3;C3)

 

[HeSanbi]

Bạn có thể sử dụng đoạn code dưới đây

G4=Order(A3,B3,C3)


Copy code vào một module
------------------------

Function Order(MainName As String, numStart As Long, numEnd As Long) As String
  Dim d As Range
  Set d = Application.Caller
  Order = MainName & CStr(numStart)
  Application.Evaluate "'" & ThisWorkbook.Name & "'!MainOrder(""" _
                           & MainName & """," _
                           & CStr(numStart + 1) & "," _
                           & CStr(numEnd) & "," _
                           & "'[" & d.Parent.Parent.Name & "]" & d.Parent.Name & "'!" & d(2, 1).Address & ")"
  Set d = Nothing
End Function
Private Function MainOrder(MainName As String, numStart As Long, numEnd As Long, target As Range)
  On Error Resume Next
  Static IUp As Boolean, IRun As Boolean
  If Not IRun Then
    IRun = True
    IUp = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Dim total(), i As Long, r As Range
    Set r = target.Parent.UsedRange
    ReDim total(1 To VBA.IIf(numEnd > r.Rows.Count, numEnd, r.Rows.Count), 1 To 1)
    For i = numStart To numEnd
      total(i - numStart + 1, 1) = MainName & CStr(i)
    Next
    target.Resize(UBound(total)).Value = total
    Set r = Nothing
    Application.ScreenUpdating = IUp
  Else
    IRun = False
  End If
End Function