Nhờ hỗ trợ về cách tạo dãy số giảm dần. (1 người xem)

[heyhey1994]

Chào tất cả mọi người trong diễn đàn,
Hiện mình đang làm 1 bảng tính mà gặp vài vấn đề nên nhờ mọi người giúp đỡ ạ.
Mình đang muốn là tạo 1 dãy số thẳng đứng như sau: sẽ trừ 1 từ số lớn nhất, có điều đặc biệt là khi nó qua lớp thứ 2 thì cái số 41.5 đó sẽ lặp lại 2 lần. mình dựa vào code của 1 anh trên diễn đàn và hiệu chỉnh lại nhưng bây giờ nó có 1 vấn đề là: nếu cái số thứ 1 trừ số thứ 2 là số nguyên thì nó không lặp lại, lúc đó nó sẽ 41.5 đến 40.5 luôn. Mình gửi kèm file tính ạ.
Xin cảm ơn.

50.5
49.5
...
...
41.5
41.5
40.5
...
4
4
3
...

 

[HieuCD]

Chào tất cả mọi người trong diễn đàn,
Hiện mình đang làm 1 bảng tính mà gặp vài vấn đề nên nhờ mọi người giúp đỡ ạ.
Mình đang muốn là tạo 1 dãy số thẳng đứng như sau: sẽ trừ 1 từ số lớn nhất, có điều đặc biệt là khi nó qua lớp thứ 2 thì cái số 41.5 đó sẽ lặp lại 2 lần. mình dựa vào code của 1 anh trên diễn đàn và hiệu chỉnh lại nhưng bây giờ nó có 1 vấn đề là: nếu cái số thứ 1 trừ số thứ 2 là số nguyên thì nó không lặp lại, lúc đó nó sẽ 41.5 đến 40.5 luôn. Mình gửi kèm file tính ạ.
Xin cảm ơn.

50.5
49.5
...
...
41.5
41.5
40.5
...
4
4
3
...
View attachment 261076

Kiểm tra lại kết quả, nếu không đúng nhập tay kết quả gởi lại file

Sub ABC()
  Dim sArr(), Res(1 To 300, 1 To 7)
  Dim i&, k&, t#
  Range("L3:R1000").ClearContents
  sArr = Range("C2", Range("I" & Rows.Count).End(xlUp)).Value
  t = sArr(1, 6)
  For i = 2 To UBound(sArr)
    If t < sArr(i - 1, 6) Then t = sArr(i - 1, 6)
    Do
      If t <> sArr(i - 1, 6) Then t = Int(t) + 0.5
      k = k + 1
      Res(k, 1) = sArr(i, 1)
      Res(k, 2) = t
      Res(k, 3) = sArr(i, 2)
      Res(k, 4) = sArr(i, 3)
      Res(k, 5) = sArr(i, 4)
      Res(k, 7) = sArr(i, 5)
      t = t - 1
      If i = UBound(sArr) Then d = t + 0.01 Else d = t
    Loop Until d <= sArr(i, 6)
  Next i
  Range("L3").Resize(k, 7) = Res
 End Sub

 

[heyhey1994]

Kiểm tra lại kết quả, nếu không đúng nhập tay kết quả gởi lại file

Sub ABC()
  Dim sArr(), Res(1 To 300, 1 To 7)
  Dim i&, k&, t#
  Range("L3:R1000").ClearContents
  sArr = Range("C2", Range("I" & Rows.Count).End(xlUp)).Value
  t = sArr(1, 6)
  For i = 2 To UBound(sArr)
    If t < sArr(i - 1, 6) Then t = sArr(i - 1, 6)
    Do
      If t <> sArr(i - 1, 6) Then t = Int(t) + 0.5
      k = k + 1
      Res(k, 1) = sArr(i, 1)
      Res(k, 2) = t
      Res(k, 3) = sArr(i, 2)
      Res(k, 4) = sArr(i, 3)
      Res(k, 5) = sArr(i, 4)
      Res(k, 7) = sArr(i, 5)
      t = t - 1
      If i = UBound(sArr) Then d = t + 0.01 Else d = t
    Loop Until d <= sArr(i, 6)
  Next i
  Range("L3").Resize(k, 7) = Res
 End Sub

Em cảm ơn anh. Nhưng em đang muốn lớp 1 sẽ kết thúc ở 41.5 và lớp 2 bắt đầu ở 41.5 ạ. Tương tự cho mấy lớp khác.

 

[HieuCD]

Em cảm ơn anh. Nhưng em đang muốn lớp 1 sẽ kết thúc ở 41.5 và lớp 2 bắt đầu ở 41.5 ạ. Tương tự cho mấy lớp khác.

Chỉnh lại

Sub ABC()
  Dim sArr(), Res(1 To 300, 1 To 7)
  Dim i&, k&, t#
  Range("L3:R1000").ClearContents
  sArr = Range("C2", Range("I" & Rows.Count).End(xlUp)).Value
  For i = 2 To UBound(sArr)
    t = sArr(i - 1, 6)
    Do
      k = k + 1
      Res(k, 1) = sArr(i, 1)
      Res(k, 2) = t
      Res(k, 3) = sArr(i, 2)
      Res(k, 4) = sArr(i, 3)
      Res(k, 5) = sArr(i, 4)
      Res(k, 7) = sArr(i, 5)
      If t = sArr(i, 6) Then Exit Do
      t = Int(t) - 0.5
      If t < sArr(i, 6) Then t = sArr(i, 6)
    Loop
  Next i
  Range("L3").Resize(k, 7) = Res
 End Sub

 

[heyhey1994]

Chỉnh lại

Sub ABC()
  Dim sArr(), Res(1 To 300, 1 To 7)
  Dim i&, k&, t#
  Range("L3:R1000").ClearContents
  sArr = Range("C2", Range("I" & Rows.Count).End(xlUp)).Value
  For i = 2 To UBound(sArr)
    t = sArr(i - 1, 6)
    Do
      k = k + 1
      Res(k, 1) = sArr(i, 1)
      Res(k, 2) = t
      Res(k, 3) = sArr(i, 2)
      Res(k, 4) = sArr(i, 3)
      Res(k, 5) = sArr(i, 4)
      Res(k, 7) = sArr(i, 5)
      If t = sArr(i, 6) Then Exit Do
      t = Int(t) - 0.5
      If t < sArr(i, 6) Then t = sArr(i, 6)
    Loop
  Next i
  Range("L3").Resize(k, 7) = Res
 End Sub

Ok rồi ạ. Em cảm ơn anh nhiều.