Code copy công thức vào cell rỗng. (1 người xem)

[Blad01]

Chào các bạn. Mong các bạn viết giúp tôi đoạn code copy công thức vào cell rỗng và đặt row 8:8 siêu ẩn. Cụ thể như sau:
Đặt tên vùng từ A8:A20 = stt, nếu vùng stt có ô rỗng thì code tự động copy công thức ở ô A8 vào ô rỗng đó. Tôi đã viết code như sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If WorksheetFunction.CountBlank(ActiveSheet.Range("stt")) > 0 Then
Range("A8").Copy Range("stt")
End Sub

Viết như trên code copy công thức vào cả vùng stt. Vì vậy nếu bảng dữ liệu dài thì không ổn lắm. Mong các bạn viết giúp đoạn code làm sao nếu trong vùng stt có ô rỗng thì code sẽ copy công thức từ ô A8 vào đúng ô rỗng trong vùng stt mà thôi và đặt row 8:8 siêu ẩn. Cảm ơn GPE !

 

[giaiphap]

Bạn sử dụng đoạn code này thử xem

    Application.Goto Reference:="stt"
    Selection.SpecialCells(xlCellTypeBlanks).Formula = Range("A8").Formula

 

[Blad01]

Bạn sử dụng đoạn code này thử xem

    Application.Goto Reference:="stt"
    Selection.SpecialCells(xlCellTypeBlanks).Formula = Range("A8").Formula

cảm ơn bạn nhiều. Code báo lỗi bạn à, mình muốn trong vùng stt có ô rỗng thì code mới chạy (ví dụ có ai đó xóa công thức trong vùng stt chẳng hạn), nếu không có ô rỗng thì code không hoạt động. Bạn có thể làm vào file đính kèm giúp mình được không.

 

[giaiphap]

cảm ơn bạn nhiều. Code báo lỗi bạn à, mình muốn trong vùng stt có ô rỗng thì code mới chạy (ví dụ có ai đó xóa công thức trong vùng stt chẳng hạn), nếu không có ô rỗng thì code không hoạt động. Bạn có thể làm vào file đính kèm giúp mình được không.

Nếu vậy bạn thử code này xem sao.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
 If Not Intersect(Target, Range("stt")) Is Nothing Then
    Application.EnableEvents = False
    Range("stt").SpecialCells(xlCellTypeBlanks).Formula = Range("A8").Formula
    Application.EnableEvents = True
 End If
End Sub

 

[Blad01]

Nếu vậy bạn thử code này xem sao.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
 If Not Intersect(Target, Range("stt")) Is Nothing Then
    Application.EnableEvents = False
    Range("stt").SpecialCells(xlCellTypeBlanks).Formula = Range("A8").Formula
    Application.EnableEvents = True
 End If
End Sub

Cảm ơn bạn giaiphap nhiều. code chạy tốt. nhưng mình muốn khi copy công thức từ ô A8 xuống ô rỗng thì công thức cũng thay đổi địa chỉ tới dòng của ô rỗng đó thì làm thế nào ? (ví dụ ô rỗng ở A15, khi copy công thức =ROW()-ROW(A8) sẽ tự động thay đổi thảnh =ROW()-ROW(A15)

 

[Blad01]

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If ActiveSheet.Name <> "B1" Then ActiveSheet.Name = "B1"
End If
If Not Intersect(Target, Range("stt")) Is Nothing Then
    Application.EnableEvents = False
    Range("stt").SpecialCells(xlCellTypeBlanks).Formula = "=ROW()-ROW($A$8)"
    Application.EnableEvents = True
End If
If Not Intersect(Target, Range("CongThuc")) Is Nothing Then
    Application.EnableEvents = False
    [COLOR=#ff0000]Range("CongThuc").SpecialCells(xlCellTypeBlanks).Formula = "=IF(AND(COUNTA(RC[-39])=0,COUNTA(RC[-9]:RC[-8])=0),"",AND(COUNTA(RC[-39])>0,COUNTA(RC[-37]:RC[-31])=1,COUNTA(RC[-27]:RC[-25])=1,COUNTA(RC[-24]:RC[-21])<2,COUNTA(RC[-20]:RC[-15])=1,COUNTA(RC[-14]:RC[-10])>=1,OR(RC[-9]>"",COUNTA(RC[-8]:RC[-7])=2,COUNTA(RC[-8]:RC[-5])=4),OR(COUNTA(RC[-9])=0,COUNTA(RC[-9])>COUNTA(RC[-8]:RC[-5])),OR(COUNTA(RC[-8]:RC[-6])=3,COUNTA(RC[-6])=COUNTA(RC[-5])),OR(AND(COUNTA(RC[-35]:RC[-34])=1,RC[-27]="",RC[-24]=""),AND(COUNTA(RC[-33]:RC[-32])=1,COUNTA(RC[-27]:RC[-26])=0,COUNTA(RC[-24]:RC[-23])=0),COUNTA(RC[-35]:RC[-32])=0)))"[/COLOR]
    Application.EnableEvents = True
End If
End Sub

Mong các bác chỉ giúp code em sử dụng có gì sai mà sao chạy nó cứ báo lỗi tùm lum lên vậy trời (báo lỗi ở dòng em bôi đỏ). Phải chăng do công thức quá dài ?. Em đã test thử bằng công thức ngắn hơn thì chạy rất tốt. VBA nó báo thế này: Run-time error '1004': Application-defined or object-defined error.
bác nào biết lỗi ở đâu chỉ em với ạ ?

 

[phulien1902]

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If ActiveSheet.Name <> "B1" Then ActiveSheet.Name = "B1"
End If
If Not Intersect(Target, Range("stt")) Is Nothing Then
    Application.EnableEvents = False
    Range("stt").SpecialCells(xlCellTypeBlanks).Formula = "=ROW()-ROW($A$8)"
    Application.EnableEvents = True
End If
If Not Intersect(Target, Range("CongThuc")) Is Nothing Then
    Application.EnableEvents = False
    [COLOR=#ff0000]Range("CongThuc").SpecialCells(xlCellTypeBlanks).Formula = "=IF(AND(COUNTA(RC[-39])=0,COUNTA(RC[-9]:RC[-8])=0),"",AND(COUNTA(RC[-39])>0,COUNTA(RC[-37]:RC[-31])=1,COUNTA(RC[-27]:RC[-25])=1,COUNTA(RC[-24]:RC[-21])<2,COUNTA(RC[-20]:RC[-15])=1,COUNTA(RC[-14]:RC[-10])>=1,OR(RC[-9]>"",COUNTA(RC[-8]:RC[-7])=2,COUNTA(RC[-8]:RC[-5])=4),OR(COUNTA(RC[-9])=0,COUNTA(RC[-9])>COUNTA(RC[-8]:RC[-5])),OR(COUNTA(RC[-8]:RC[-6])=3,COUNTA(RC[-6])=COUNTA(RC[-5])),OR(AND(COUNTA(RC[-35]:RC[-34])=1,RC[-27]="",RC[-24]=""),AND(COUNTA(RC[-33]:RC[-32])=1,COUNTA(RC[-27]:RC[-26])=0,COUNTA(RC[-24]:RC[-23])=0),COUNTA(RC[-35]:RC[-32])=0)))"[/COLOR]
    Application.EnableEvents = True
End If
End Sub

Mong các bác chỉ giúp code em sử dụng có gì sai mà sao chạy nó cứ báo lỗi tùm lum lên vậy trời (báo lỗi ở dòng em bôi đỏ). Phải chăng do công thức quá dài ?. Em đã test thử bằng công thức ngắn hơn thì chạy rất tốt. VBA nó báo thế này: Run-time error '1004': Application-defined or object-defined error.
bác nào biết lỗi ở đâu chỉ em với ạ ?

Bạn thay "Formula" bằng "FormulaR1C1" xem thế nào nhé.

 

[anhdepjai]

Bạn nào đặt code siêu ẩn với range thì cho mình tham khảo với

 

[Blad01]

Bạn thay "Formula" bằng "FormulaR1C1" xem thế nào nhé.

Thêm vào cũng không được, vẫn báo lỗi bác à.

 

[anhdepjai]

Bạn gửi thẳng cái file lên đây xem nào.

 

[Blad01]

Bạn gửi thẳng cái file lên đây xem nào.

File của em khá nặng vì nhiều dữ liệu lại có 41 sheet ẩn lên em ngại đưa lên. Em tìm được ra lỗi rồi, nguyên nhân là do có dấu "" trong công thức của excel. Em đã thay dấu nháy đó bằng số 0, thế là code chạy ngon.
Nhưng có một vấn đề khác phát sinh làm em đau đầu mong các bác chỉ giáo: Công thức của em quá dài (dài hơn 1024 kí tự trên một dòng mà vba cho phép), nên vba báo lỗi. Vậy làm cách nào để có thể để vba copy một công thức nhiều hơn 1024 kí tự vào cell của excel. ví dụ:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("CongThuc")) Is Nothing Then    
Application.EnableEvents = False
    On Error Resume Next
    Range("CongThuc").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=AND(COUNTA(RC[-44])>0,COUNTA(RC[-42]:RC[-36])=1,COUNTA(RC[-32]:RC[-30])=1,COUNTA(RC[-29],RC[-26],RC[-23]:RC[-22])<=1,COUNTA(RC[-21]:RC[-16])=1,COUNTA(RC[-15]:RC[-9])>=1,AND(OR(AND(RC[-29]>0,COUNTA(RC[-28]:RC[-27])<=1),COUNTA(RC[-29]:RC[-27])=0),OR(AND(RC[-26]>0,COUNTA(RC[-25]:RC[-24])<=1),COUNTA(RC[-26]:RC[-24])=0),OR(COUNTA(RC[-29],RC[-26],RC[-23]:RC[-22])<=1,AND(RC[-29]>0,COUNTA(RC[-26]:RC[-22])=0),AND(RC[-26]>0,COUNTA(RC[-29],RC[-23]:RC[-22])=0),AND(COUNTA(RC[-23]:RC[-22])=1,COUNTA(RC[-29]:RC[-24])=0))),OR(AND(COUNTA(RC[-8]:RC[-7])=1,RC[-6]=0),IF(RC[-8]=0,RC[-6]>0,FALSE)),IF(COUNTA(RC[-44])>0,OR(AND(RC[-8]>0,COUNTA(RC[-7]:RC[-5])=0),AND(RC[-7]>0,RC[-5]=0),AND(RC[-6]>0,RC[-7]=0),COUNTA(RC[-7]:RC[-5])=3,FALSE)),OR(AND(RC[-42]>0),AND(RC[-41]>0,COUNTA(RC[-28]:RC[-27])=0),AND(RC[-40]>0,RC[-32]=0,COUNTA(RC[-29]:RC[-27])=0),AND(RC[-39]>0,RC[-32]=0,COUNTA(RC[-29]:RC[-27])=0,COUNTA(RC[-25]:RC[-24])=0),AND(RC[-38]>0,COUNTA(RC[-32]:RC[-31])=0,COUNTA(RC[-29]:RC[-24])=0),AND(RC[-37]>0,COUNTA(RC[-32]:RC[-31])=0,COUNTA(RC[-29]:RC[-24])=0),COUNTA(RC[-42]:RC[-37])=0))"
    Application.EnableEvents = True
End If
End Sub

Mong các bạn giúp đỡ. Cảm ơn nhiều lắm.