Tăng dần number để thỏa mãn điều kiện

[hadoan-pap]

Em chào mọi người!

Dạ, em có 1 bài toán của Sản Xuất mà e có minh họa như dưới ạ.

- Sheet1 chứa thông tin Mã Hàng và thông tin điều chỉnh
- Sheet2 chứa thông tin Mã Hàng và các ngày cần điều chỉnh trong tháng

Ở Sheet2 thì sẽ chạy lần lượt từng ngày theo từng Mã Hàng để kiểm tra... Nếu tại ô ngày có giá trị dương thì remove công thức giữ lại giá trị, còn nếu là âm thì sẽ tăng dần số Number ở cột B đến khi nào >=0 thì sẽ remove công thức ( chỉ giữ lại Value )... sau đó trả kết quả về Sheet1 cột B về các thông tin đã điều chỉnh ạ.

Em xin cảm ơn ạ!

 

[HieuCD]

Em chào mọi người!

Dạ, em có 1 bài toán của Sản Xuất mà e có minh họa như dưới ạ.

- Sheet1 chứa thông tin Mã Hàng và thông tin điều chỉnh
- Sheet2 chứa thông tin Mã Hàng và các ngày cần điều chỉnh trong tháng

Ở Sheet2 thì sẽ chạy lần lượt từng ngày theo từng Mã Hàng để kiểm tra... Nếu tại ô ngày có giá trị dương thì remove công thức giữ lại giá trị, còn nếu là âm thì sẽ tăng dần số Number ở cột B đến khi nào >=0 thì sẽ remove công thức ( chỉ giữ lại Value )... sau đó trả kết quả về Sheet1 cột B về các thông tin đã điều chỉnh ạ.

Em xin cảm ơn ạ!

Kết quả khác tí xíu

Option Explicit
Sub XYZ()
  Dim rng As Range, rNum As Range, res()
  Dim sRow&, scol&, fCol&, i&, r&, j&
  With Sheets("Sheet2")
    Set rng = .Range("C1", .Cells(3, .Range("AAA2").End(xlToLeft).Column))
    Set rNum = .Range("B2")
  End With
  sRow = rng.Rows.Count:    scol = rng.Columns.Count
  ReDim res(2 To sRow, 1 To 2)
  For i = 2 To sRow
    res(i, 1) = Sheets("Sheet2").Range("A" & i).Value
    rNum.Value = 4
    fCol = 1
    For j = fCol To scol
      If rng(i, j) < 1 Then
        For r = 5 To 10
          rNum.Value = r
          If rng(i, j) = 1 Then
            Call addRes(rng, res, fCol, i, j, r)
            fCol = j + 1
            rNum.Value = 4
            Exit For
          End If
        Next r
      End If
    Next j
    If fCol <= scol And fCol > 1 Then Call addRes(rng, res, fCol, i, scol, 4)
  Next i
  Sheets("Sheet1").Range("D2").Resize(sRow - 1, 2) = res
End Sub

Private Sub addRes(rng, res, fCol, i, ByVal j, ByVal r)
  Dim c&, tmp$
    For c = fCol To j
      rng(i, c).Value = rng(i, c).Value
    Next c
    tmp = "[" & Format(rng(1, fCol), "dd.mm.yyyy")
    If fCol = j Then
      tmp = tmp & "]: " & r
    Else
      tmp = tmp & " - " & Format(rng(1, j), "dd.mm.yyyy") & "]: " & r
    End If
    If res(i, 2) = Empty Then
      res(i, 2) = res(i, 2) & tmp
    Else
      res(i, 2) = res(i, 2) & Chr(10) & tmp
    End If
End Sub

 

[hadoan-pap]

Kết quả khác tí xíu

Option Explicit
Sub XYZ()
  Dim rng As Range, rNum As Range, res()
  Dim sRow&, scol&, fCol&, i&, r&, j&
  With Sheets("Sheet2")
    Set rng = .Range("C1", .Cells(3, .Range("AAA2").End(xlToLeft).Column))
    Set rNum = .Range("B2")
  End With
  sRow = rng.Rows.Count:    scol = rng.Columns.Count
  ReDim res(2 To sRow, 1 To 2)
  For i = 2 To sRow
    res(i, 1) = Sheets("Sheet2").Range("A" & i).Value
    rNum.Value = 4
    fCol = 1
    For j = fCol To scol
      If rng(i, j) < 1 Then
        For r = 5 To 10
          rNum.Value = r
          If rng(i, j) = 1 Then
            Call addRes(rng, res, fCol, i, j, r)
            fCol = j + 1
            rNum.Value = 4
            Exit For
          End If
        Next r
      End If
    Next j
    If fCol <= scol And fCol > 1 Then Call addRes(rng, res, fCol, i, scol, 4)
  Next i
  Sheets("Sheet1").Range("D2").Resize(sRow - 1, 2) = res
End Sub

Private Sub addRes(rng, res, fCol, i, ByVal j, ByVal r)
  Dim c&, tmp$
    For c = fCol To j
      rng(i, c).Value = rng(i, c).Value
    Next c
    tmp = "[" & Format(rng(1, fCol), "dd.mm.yyyy")
    If fCol = j Then
      tmp = tmp & "]: " & r
    Else
      tmp = tmp & " - " & Format(rng(1, j), "dd.mm.yyyy") & "]: " & r
    End If
    If res(i, 2) = Empty Then
      res(i, 2) = res(i, 2) & tmp
    Else
      res(i, 2) = res(i, 2) & Chr(10) & tmp
    End If
End Sub

Dạ, em xin cảm ơn anh nhiều ạ ^^