Chèn thêm dòng dữ liệu có điều kiện

HOACOMAY2010 · 26/7/10

Em có các bảng số liệu đo gồm 3 cột là: A là số TT, B là khoảng cách, C là cột độ cao . em muốn chèn thêm vào bảng số liệu đo này những khảng cách (là gia trị dòng dưới trừ dòng trên liền kề nó )>20m thì chèn thêm 1 dòng và giá trị bằng giá trị dòng trước nó + thêm số ngẫu nhiên <20,còn cột C thì tính tương ứng theo tỉ lệ giá trị chèn vào. Chèn dòng sao cho giá trị dòng trên trừ dưới luôn < 20. Các bác viết VBA giúp em với nhé, em viết không được, em đang cần gấp.

SA_DQ · 26/7/10

Macro của bạn đây

PHP:

Option Explicit
Sub AddRow20()
 Dim jJ As Long, eRw As Long, SoNgau As Double
 Dim Cls As Range, B1 As Range, C1 As Range

 eRw = [B65500].End(xlUp).Row
 For jJ = 3 To eRw
   If Cells(jJ, "B").Value > Cells(jJ - 1, "B").Value + 20 Then
      Cells(jJ, "B").EntireRow.Insert
      Randomize:           SoNgau = 1 + 19 * Rnd()
      Cells(jJ, "B").Value = SoNgau + Cells(jJ - 1, "B").Value
      Set B1 = Cells(jJ - 1, "B"):                 Set C1 = B1.Offset(, 1)
      Cells(jJ, "c").Value = C1 + ((C1.Offset(2) - C1) * (B1.Offset(1) - B1)) / (B1.Offset(2) - B1)
      Cells(jJ, "B").Interior.ColorIndex = 35
      jJ = jJ + 1
   End If
 Next jJ 
End Sub

HOACOMAY2010 · 27/7/10

Chèn dòng dữ liệu có điều kiện

Cảm ơn HYen 17 nhiều. code của bác chạy đúng mục đích của bài toán, nhưng bác sửa cho em mấy vấn đề sau giúp em:
- code của bác chỉ chạy đến dòng số TT 19 mà không tính hết cả cột dữ liệu. (file dữ liệu gồm nhiều bảng, kết thúc mỗi bảng có dấu "-" trước số TT cuối cùng.)
- và dòng TT 5 , 6 bác chèn cho em là 3 dòng vì giá trị dòng 5, 6 là 148.4-103.2=45.2, vì mỗi dòng độ lệch <20 nên phải chèn thêm3 dòng.
- Cột C giá trị có chỗ tính chưa đúng công thức: =(dòng dưới C-dòng trên C)/(dòng dưới C-dòng dưới B)* giá trị chèn thêm dòng B + dòng trên C. như đoạn số tt 10-11 giá trị độ cao tính chưa đúng
bác xem và sửa giúpem với nhé.

SA_DQ · 28/7/10

Mình sửa lại macro rồi đây

PHP:

Option Explicit
Sub AddRow20()
 Dim jJ As Long, eRw As Long, SoNgau As Double, MColor As Byte
 Dim Cls As Range, B1 As Range, C1 As Range

 eRw = 2 * [B65500].End(xlUp).Row    '<=| Tang Doi Só Dòng Càn Xu Lí'
 With [A1].Interior
   If .ColorIndex < 34 Or .ColorIndex > 42 Then
      MColor = 35
   Else
      MColor = .ColorIndex + 1
   End If
   .ColorIndex = MColor
 End With
 For jJ = 3 To eRw
   If Cells(jJ, "B").Value > Cells(jJ - 1, "B").Value + 20 Then
      Cells(jJ, "B").EntireRow.Insert
      Randomize:           SoNgau = 1 + 19 * Rnd()
      Cells(jJ, "B").Value = SoNgau + Cells(jJ - 1, "B").Value
      Set B1 = Cells(jJ - 1, "B"):                 Set C1 = B1.Offset(, 1)
      Cells(jJ, "c").Value = C1 + ((C1.Offset(2) - C1) * (B1.Offset(1) - B1)) / (B1.Offset(2) - B1)
      Cells(jJ, "B").Interior.ColorIndex = MColor
      jJ = jJ + 1
   End If
 Next jJ
End Sub

(1) Để chèn thêm nhiều dòng thì tạm thời chịu khó chạy macro thêm lần nữa,. . . cho đến khi hết dòng cần chèn. Mà việc này bạn không nói ngay từ đầu đó nha. (Cứ vậy coi chừng bị fạt đó bạn!)

(2) Cách tính trị để thêm vô cột 'C' thuộc dòng nào đó là như nhau; Không lí nào có dòng tính đúng, dòng lại tính chưa đúng. (Có khi cần thảo luận thêm chổ ni không chừng!)

HOACOMAY2010 · 28/7/10

Chèn dòng dữ liệu có điều kiện

Xin lỗi bác HYEN 17 nhé, code của bác đã tính đúng cho cột C, do em tính bị nhầm lẫn thôi. Bác làm giúp vấn đề nữa là:
- giá trị giữa các dòng liền kề trong 1 bảng không nhỏ hơn 5
- Bác làm sao chỉ chạy code 1 lần là chèn đủ số dòng, không phải bấm nhiều lần, rất khó kiểm soát và không Pro bác ạ.
- và chạy xong bác làm lại cho em cột A là số tt cho liên tục, và có thông báo tổng dòng chèn cho từng bảng bác nhé.em có file kèm theo nhờ bác xem giúp. em xin cảm ơn bác rất rất nhiều...

SA_DQ · 28/7/10

Có thể là chưa thật Pro như bạn muốn

PHP:

Option Explicit
Sub AddRow20()
 Dim jJ As Long, eRw As Long, SoNgau As Double, MColor As Byte, DG As Double
 Dim B1 As Range, C1 As Range, GPE As Boolean

 eRw = 2 * [B65500].End(xlUp).Row    '<=| Tang Doi Só Dòng Càn Xu Lí'
 With [A1].Interior
   If .ColorIndex < 34 Or .ColorIndex > 42 Then
      MColor = 35
   Else
      MColor = .ColorIndex + 1
   End If
   .ColorIndex = MColor
 End With
 For jJ = 3 To eRw
   If Cells(jJ, "B").Value > Cells(jJ - 1, "B").Value + 20 Then
      GPE = True
      Cells(jJ, "B").EntireRow.Insert
      DG = Cells(jJ + 1, "B") - Cells(jJ - 1, "B") - 15
      Randomize:                    SoNgau = 7 + 9 * Rnd()
      
      Cells(jJ, "B").Value = SoNgau + Cells(jJ - 1, "B").Value
      Set B1 = Cells(jJ - 1, "B"):                 Set C1 = B1.Offset(, 1)
      Cells(jJ, "c").Value = C1 + ((C1.Offset(2) - C1) * (B1.Offset(1) - B1)) / (B1.Offset(2) - B1)
      Cells(jJ, "B").Interior.ColorIndex = MColor
      jJ = jJ + 1
   Else
   End If
   Cells(jJ, "A").Value = 1 + Cells(jJ - 1, "A")
 Next jJ
 If GPE Then
   GPE = False:                              AddRow20
 Else
   Cells([B65500].End(xlUp).Row + 1, "A").Resize(eRw).ClearContents
   Exit Sub
 End If
 Set C1 = [d1]:                              jJ = 0
 GPE = False:                                eRw = 0
 SoNgau = CInt(Right([A1], 1))
 For Each B1 In Range([B2], [B65500].End(xlUp))
   eRw = 1 + eRw
   If B1.Interior.ColorIndex > 9 Then jJ = jJ + 1
   If GPE = True Then B1.Offset(, -1).Value = eRw
   If B1.Value = "" Then
      C1.Value = "Add " & jJ & " rows":      GPE = True
      Set C1 = B1.Offset(, 2):               jJ = 0
      SoNgau = SoNgau + 1:                   eRw = 0
      B1.Offset(, -1).Value = "Bang" & Str(SoNgau)
   End If
 Next B1
 C1.Value = "Add " & jJ & " rows"
End Sub

HOACOMAY2010 · 29/7/10

Tốt quá rồi bác HYen 17 ạ, với em thế là Pro rồi sư phụ ạ. Tiện thể Sư phụ giúp em xử lý vụ xoá dòng này nhé. em muốn so sánh các giá trị trong bảng dữ liệu với nhau và xoá những dòng có giá trị nhỏ hơn một số cho trước, em có file kèm theo nhờ sư phụ xem giúp

Bác HYen 17 ơi, giúp em bổ sung thêm code "Chèn dòng dữ liệu có điều kiện " của bác viết với.
- Bác thêm dấu "-" vào trước số thứ tự cuối cùng của từng bảng như lúc ban đầu nhé.

SA_DQ · 31/7/10

Bạn thêm các dòng lệnh có số lớn hơn 0 sau vô macro cũ

Bác ơi, giúp bổ sung thêm code "Chèn dòng dữ liệu có điều kiện " với.
- Bác thêm dấu "-" vào trước số thứ tự cuối cùng của từng bảng như lúc ban đầu nhé.

PHP:

0      B1.Offset(, -1).Value = "Bang" & Str(SoNgau)
6      B1.Offset(-1, -1).Value = -B1.Offset(-1, -1).Value
   End If
 Next B1
 C1.Value = "Add " & jJ & " rows"
7 With [A65500].End(xlUp)
8   .Value = -.Value
9 End With
End Sub

HOACOMAY2010 · 31/7/10

Đoạn code này chèn thêm vào chỗ nào vậy bác? bác chỉ em với. Em chèn thêm đoạn code của bác nhưng chạy ra không đúng yêu cầu.

hoangtronglanh · 1/8/10

Xin chào các bác! Đơn vị của em chuyên quản lý và bán điện , nên hàng tháng phải in một lượng hóa đơn tiền điện rất nhiều (khoảng 3.000 tờ). Trong phần mềm tính tiền và in hóa đơn có dòng "Giám đốc ký, ghi rõ họ tên và đóng dấu" .Làm thế nào để chèn được chữ ký của Giám đốc vào một tờ hóa đơn mẫu rồi in ra nhiều hóa đơn có chữ ký của Giám đốc được, có bác nào biết xin hướng dẫn cho xin được cảm ơn trước!

HOACOMAY2010 · 4/8/10

Bác Hyen17 đâu mất rùi, em chèn đoạn cốt bổ sung của bác sao chạy không được. bác xem lại em với nhé.
0 B1.Offset(, -1).Value = "Bang" & Str(SoNgau)
6 B1.Offset(-1, -1).Value = -B1.Offset(-1, -1).Value
End If
Next B1
C1.Value = "Add " & jJ & " rows"
7 With [A65500].End(xlUp)
8 .Value = -.Value
9 End With
End Sub
- Bác thêm dấu "-" vào trước số thứ tự cuối cùng của từng bảng như lúc ban đầu nhé.

SA_DQ · 4/8/10

PHP:

Option Explicit
Sub AddRow20()
 Dim jJ As Long, eRw As Long, SoNgau As Double, MColor As Byte, DG As Double
 Dim B1 As Range, C1 As Range, GPE As Boolean

 eRw = 2 * [B65500].End(xlUp).Row    '<=| Tang Doi Só Dòng Càn Xu Lí'
 With [A1].Interior
   If .ColorIndex < 34 Or .ColorIndex > 42 Then
      MColor = 35
   Else
      MColor = .ColorIndex + 1
   End If
   .ColorIndex = MColor
 End With
 For jJ = 3 To eRw
   If Cells(jJ, "B").Value > Cells(jJ - 1, "B").Value + 20 Then
      GPE = True
      Cells(jJ, "B").EntireRow.Insert
      DG = Cells(jJ + 1, "B") - Cells(jJ - 1, "B") - 15
      Randomize:                    SoNgau = 7 + 9 * Rnd()
      
      Cells(jJ, "B").Value = SoNgau + Cells(jJ - 1, "B").Value
      Set B1 = Cells(jJ - 1, "B"):                 Set C1 = B1.Offset(, 1)
      Cells(jJ, "c").Value = C1 + ((C1.Offset(2) - C1) * (B1.Offset(1) - B1)) / (B1.Offset(2) - B1)
      Cells(jJ, "B").Interior.ColorIndex = MColor
      jJ = jJ + 1
   Else
   End If
   Cells(jJ, "A").Value = 1 + Cells(jJ - 1, "A")
 Next jJ
 If GPE Then
   GPE = False:                              AddRow20
 Else
   Cells([B65500].End(xlUp).Row + 1, "A").Resize(eRw).ClearContents
   Exit Sub
 End If
 Set C1 = [d1]:                              jJ = 0
 GPE = False:                                eRw = 0
 SoNgau = CInt(Right([A1], 1))
 For Each B1 In Range([B2], [B65500].End(xlUp))
   eRw = 1 + eRw
   If B1.Interior.ColorIndex > 9 Then jJ = jJ + 1
   If GPE = True Then B1.Offset(, -1).Value = eRw
   If B1.Value = "" Then
      C1.Value = "Add " & jJ & " rows":      GPE = True
      Set C1 = B1.Offset(, 2):               jJ = 0
      SoNgau = SoNgau + 1:                   eRw = 0
      B1.Offset(, -1).Value = "Bang" & Str(SoNgau) '<=| Đây là dòng lệnh số '0
 6           B1.Offset(-1, -1).Value = -B1.Offset(-1, -1).Value   'Thêm Dòng lệnh 6'
   End If
 Next B1
 C1.Value = "Add " & jJ & " rows"
 'Thêm các Dòng Lệnh Còn Lại Vô Đây:'
7 With [A65500].End(xlUp)
8      .Value = -.Value
9 End With
End Sub

(Dòng lệnh mang số 8 sẽ gán số âm lên trị đó.

Em chèn đoạn cốt bổ sung của bác sao chạy không được. bác xem lại em với nhé.
0 B1.Offset(, -1).Value = "Bang" & Str(SoNgau)
6 B1.Offset(-1, -1).Value = -B1.Offset(-1, -1).Value
End If
Next B1
C1.Value = "Add " & jJ & " rows"
7 With [A65500].End(xlUp)
8 .Value = -.Value
9 End With
End Sub
- Bác thêm dấu "-" vào trước số thứ tự cuối cùng của từng bảng như lúc ban đầu nhé.

HOACOMAY2010 · 11/8/10

Cảm ơn bác Hyen 17.code da chay ngon lành. chuc bac hạnh phúc và thành dat trong cuộc sống

Chèn thêm dòng dữ liệu có điều kiện

HOACOMAY2010

Thành viên mới

File đính kèm

SA_DQ

/(hông là gì!

HOACOMAY2010

Thành viên mới

SA_DQ

/(hông là gì!

HOACOMAY2010

Thành viên mới

File đính kèm

SA_DQ

/(hông là gì!

File đính kèm

HOACOMAY2010

Thành viên mới

File đính kèm

SA_DQ

/(hông là gì!

HOACOMAY2010

Thành viên mới

hoangtronglanh

Thành viên mới

HOACOMAY2010

Thành viên mới

SA_DQ

/(hông là gì!

HOACOMAY2010

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian