Kısa Açıklama
Veri Düzenleme Makrosu Döngü Hatası isimli başlıkta, ilgili işlemlere dair detaylar yer almaktadır.- Excel Versiyonu
- Excel 2016
- Excel Sürümü
- 64 Bit
- Excel Dili
- Türkçe
Merhaba,
Ekte eklediğim dosyada düzenlenecek data sayfasındaki datayı önce text to column ile uygun hale getiriyorum (makrosu hazır.) daha sonra boş hücreye gelene kadar ilk satırda yazan değer ile sutünları dolduruyorum. Boş hücreye geldiğinde boş satırı silip yeni satırda bulunan değeri aynı işlemi yapmam gerekiyor.
Yazdığım bu kodda boş hücreyi algılamıyor ve hepsine FVM1 yazdırıyor. Boş hücreyi algılaması için ne yapmalıyım? Şimdiden teşekkürler.
Sub Macro6()
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(19, 1), Array(30, 1), Array(36, 1), Array(43, 1), _
Array(48, 1), Array(55, 1)), TrailingMinusNumbers:=True
Rows("1:8").Select
Range("A8").Activate
Selection.Delete Shift:=xlUp
End Sub
Sub dzn()
Dim x As Integer
For x = 2 To 201
If Cells(x, 1) <> "" Then
Range("A" & x).Select
Selection.Copy
Range("A" & x + 1).Select
ActiveSheet.Paste
ElseIf Cells(x, 1) = "" Then
Rows(x).Delete Shift:=xlUp
End If
Next
End Sub
Ekte eklediğim dosyada düzenlenecek data sayfasındaki datayı önce text to column ile uygun hale getiriyorum (makrosu hazır.) daha sonra boş hücreye gelene kadar ilk satırda yazan değer ile sutünları dolduruyorum. Boş hücreye geldiğinde boş satırı silip yeni satırda bulunan değeri aynı işlemi yapmam gerekiyor.
Yazdığım bu kodda boş hücreyi algılamıyor ve hepsine FVM1 yazdırıyor. Boş hücreyi algılaması için ne yapmalıyım? Şimdiden teşekkürler.
Sub Macro6()
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(19, 1), Array(30, 1), Array(36, 1), Array(43, 1), _
Array(48, 1), Array(55, 1)), TrailingMinusNumbers:=True
Rows("1:8").Select
Range("A8").Activate
Selection.Delete Shift:=xlUp
End Sub
Sub dzn()
Dim x As Integer
For x = 2 To 201
If Cells(x, 1) <> "" Then
Range("A" & x).Select
Selection.Copy
Range("A" & x + 1).Select
ActiveSheet.Paste
ElseIf Cells(x, 1) = "" Then
Rows(x).Delete Shift:=xlUp
End If
Next
End Sub
