Tự động điền số (2 người xem)

[2007thanhlp]

Mình có VD nhỏ :
- Giờ mình nhập tại SỐ Ô NHẬP, VD LÀ 13 thì các cell sẽ thể hiện theo như trên. Từ 1 => 13 theo thứ tự như vậy.
Nhờ cả nhà chỉ giúp.

 

[HUONGHCKT]

Mình có VD nhỏ :
- Giờ mình nhập tại SỐ Ô NHẬP, VD LÀ 13 thì các cell sẽ thể hiện theo như trên. Từ 1 => 13 theo thứ tự như vậy.
Nhờ cả nhà chỉ giúp.

Nếu chỉ có mỗi ô N5 là ô nhập dữ liệu đầu vào thì có thể làm được bằng VBA
nhập N5=13 lập tức các ô từ B5:K10 =1,2,3,... và tràn xuống dòng dưới B6=11,C6=12 và K6 =13.
nếu N5=xxx thì nó sẽ trải các số lấp đầy các ô Từ B5:K... riêng Kxxx=N5

Hỏi là có khi nào nhập N6 để ta cũng thư được 1 dãy số như nhập ở N5 không? và nếu có thì Những B6=11,C6=12,... sẽ bị xóa bỏ hay thế nào?

 

[2007thanhlp]

Nếu chỉ có mỗi ô N5 là ô nhập dữ liệu đầu vào thì có thể làm được bằng VBA
nhập N5=13 lập tức các ô từ B5:K10 =1,2,3,... và tràn xuống dòng dưới B6=11,C6=12 và K6 =13.
nếu N5=xxx thì nó sẽ trải các số lấp đầy các ô Từ B5:K... riêng Kxxx=N5

Hỏi là có khi nào nhập N6 để ta cũng thư được 1 dãy số như nhập ở N5 không? và nếu có thì Những B6=11,C6=12,... sẽ bị xóa bỏ hay thế nào?

Cám ơn bạn đã phản hồi.
Nếu ta nhập N7 thì ta cũng sẽ thu được 1 dãy số từ B đến K, khi N5 ta nhập 13 thì nó đã tràn xuống N6 các số 11 12 13 nên bắt buộc phải nhập xuống N7 và số từ B=>K sẽ là số tiếp nối, VD 14 15 16...

 

[le_vis]

Mình có VD nhỏ :
- Giờ mình nhập tại SỐ Ô NHẬP, VD LÀ 13 thì các cell sẽ thể hiện theo như trên. Từ 1 => 13 theo thứ tự như vậy.
Nhờ cả nhà chỉ giúp.

Thay đổi số tại N5 ===> Xem kết quả đúng theo yêu cầu chưa ?

 

[le_vis]

Cám ơn bạn đã phản hồi.
Nếu ta nhập N7 thì ta cũng sẽ thu được 1 dãy số từ B đến K, khi N5 ta nhập 13 thì nó đã tràn xuống N6 các số 11 12 13 nên bắt buộc phải nhập xuống N7 và số từ B=>K sẽ là số tiếp nối, VD 14 15 16...

Bạn nhập thử mong muốn của mình khi nhập vào N5 = 12; N5 = 13 ...... và N5 = 4 trở xuống thì kết quả của bạn cần là gì ?

 

[HUONGHCKT]

Cám ơn bạn đã phản hồi.
Nếu ta nhập N7 thì ta cũng sẽ thu được 1 dãy số từ B đến K, khi N5 ta nhập 13 thì nó đã tràn xuống N6 các số 11 12 13 nên bắt buộc phải nhập xuống N7 và số từ B=>K sẽ là số tiếp nối, VD 14 15 16...

Ý tôi là bạn đã nhập N5=13 (hoặc số khác>10) và đã thu được kết quả từ b5:k6 rồi , nhưng giò ta nhập tiếp vào n6 thì dữ liệu kết quả dduocj nhập vào đâu? nếu la tư b6:k6 thì dữ liệu cũ sẽ bị xóa. ý bạn thế nào?

 

[2007thanhlp]

Ý tôi là bạn đã nhập N5=13 (hoặc số khác>10) và đã thu được kết quả từ b5:k6 rồi , nhưng giò ta nhập tiếp vào n6 thì dữ liệu kết quả dduocj nhập vào đâu? nếu la tư b6:k6 thì dữ liệu cũ sẽ bị xóa. ý bạn thế nào?

nếu nhập dữ liệu vào n6 thì sẽ như thế này :

 

[HUONGHCKT]

nếu nhập dữ liệu vào n6 thì sẽ như thế này : View attachment 312154

Trong khi chờ đợi hãy thử xem file xem sao.
Nhấn nút "Run Code" để xem kết quả trẻ về.

Bài đã được tự động gộp: Thứ bảy lúc 20:24

 

[ptm0412]

Code thì có code đây:

Public LastNum As Long
'_______________________'
Sub DienSoPtm()
LastNum = 0
Dim LastRw As Long, NumArr
With Sheets("VD")
    .Range("B6:L100").ClearContents
    LastRw = .[N1000].End(xlUp).Row
    NumArr = .Range("N5:N" & LastRw).Value
    If LastRw = 5 Then
        Dien1So NumArr, 0
    Else
        For j = 1 To UBound(NumArr)
            Dien1So NumArr(j, 1), LastNum
        Next j
    End If
End With
End Sub
'_____________________'
Sub Dien1So(ByVal So As Long, LastNum As Long)
r = Sheets("VD2").[L1000].End(xlUp).Row + 1
c = 1
Dim NextNum As Long
For i = 1 To So
    NextNum = LastNum + i
    If i = So And c < 12 Then c = 12 Else c = c + 1
    If c > 12 Then r = r + 1: c = 2
    Sheets("VD").Cells(r, c).Value = NextNum
Next
LastNum = LastNum + So
End Sub

 

[ptm0412]

Code dùng mảng và fix lỗi số là 12 hoặc (bội của 11) + 1

Public LastNum As Long, r As Long, ResArr(1 To 10000, 1 To 12)
'______________'
Sub DienSoPtm()
LastNum = 0
r = 0
Dim LastRw As Long, NumArr
With Sheets("VD")
    .Range("A6:L10000").ClearContents
    LastRw = .[N1000].End(xlUp).Row
    NumArr = .Range("N5:N" & LastRw).Value
    If LastRw = 5 Then
        Dien1So NumArr, 0
    Else
        For j = 1 To UBound(NumArr)
            Dien1So NumArr(j, 1), LastNum
        Next j
    End If
    .[A6].Resize(r, 12).Value = ResArr
End With
Erase ResArr
End Sub
'_________'
Sub Dien1So(ByVal So As Long, LastNum As Long)
r = r + 1
c = 1
Dim NextNum As Long

For i = 1 To So
    NextNum = LastNum + i
    If i = So And c < 12 Then c = 12 Else c = c + 1
    If c > 12 Then r = r + 1: c = 2
    If i = So And c = 2 Then c = 12
    If i = 1 Then ResArr(r, 1) = So
    ResArr(r, c) = NextNum
Next
LastNum = LastNum + So
End Sub

 

[HieuCD]

Kết quả từ cột "B" đến cột "K"

Sub xyz()
  Dim Sh As Worksheet, eR&, N&, r&, i&, k&, t&, col&
 
  Set Sh = Sheets("VD")
  i = Sh.Range("K1000000").End(xlUp).Row
  If i >= 5 Then Sh.Range("B5:K" & i).ClearContents
  eR = Sh.Range("N1000000").End(xlUp).Row
  If eR >= 5 Then
    r = 5 'Dòng ket qua dau tien
    Application.ScreenUpdating = False
    For i = 5 To eR
      col = 1 'Thu tu cot ket qua "B" - 1 = 1
      N = Sh.Range("N" & i).Value - 1
      For k = 1 To N
        t = t + 1
        col = col + 1
        Sh.Cells(r, col).Value = t
        If col = 11 Then 'Cot cuoi cua ket qua là cot "K"
          r = r + 1:         col = 1
        End If
      Next k
      If k > 1 Then ' dong nhap >=1
        t = t + 1
        Sh.Cells(r, 11).Value = t
        r = r + 1
      End If
    Next i
    Application.ScreenUpdating = True
  End If
End Sub