- Katılım
- 6 Mayıs 2014
- Mesajlar
- 264
- Excel Vers. ve Dili
- office 365
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Maalesef olmadı. Bu yöntem hatayı engelledi ancak sonuç hala yanlış. "deneme_1" makrosu da aynı şekilde tabloyu uzattığımda sonucu yanlış veriyorMerhaba
Bütün kodlarınza
Sub Deneme_2()
Dim Say As Long
Dim Bak As Long
Dim Alan As String
On Error Resume Next
Say = Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To Say
If Cells(i, "A") <> "" And Cells(i, "E") = "" Then
If Alan = "" Then
Range("E" & i).Select
End If
Alan = Range("E" & i).Address
Range(Selection.Address & "," & Alan).Select
End If
Next
End Sub
Şeklinde ekleyip denermisiniz
Sub Deneme_2()
Dim Say As Long
Say = Cells(Rows.Count, "A").End(xlUp).Row
Range("E1:E" & Say).SpecialCells(xlCellTypeBlanks).Select
End Sub
$E$3,$E$3,$E$4,$E$5,$E$7,$E$8,$E$10,$E$11,$E$12,$E$13,$E$14,$E$15,$E$16,$E$17,$E$18,$E$19,$E$20,$E$21,$E$22,$E$23,$E$24,$E$25,$E$26,$E$27,$E$28,$E$29,$E$30,$E$31,$E$32,$E$33,$E$34,$E$35,$E$36,$E$37,$E$38,$E$39,$E$40,$E$41,$E$42,$E$43,$E$44,$E$45,$E$46,$E$47
Sub Deneme_2()
Dim Say As Long
Say = Cells(Rows.Count, "A").End(xlUp).Row
For Each hucre In Range("E2:E" & Say)
If hucre.Offset(0, -4) <> "" And hucre = "" Then
[E2].Copy hucre
End If
Next
End Sub
Sub DENEME_1_ÇİFT_SÜTUN()
Dim Say As Long
Say = Cells(Rows.Count, "A").End(xlUp).Row
For Each hucre In Range("E2:F" & Say)
If Cells(hucre.Row, "A") = "" And hucre <> "" Then
hucre.ClearContents
End If
Next
End Sub