Kopyala - Yapıştır - yardım

[hlojan]

X      4.503

Y      0.000

X      4.499

Y      0.001

X      4.625

Y      0.000

X      4.514

Y      0.000

Bu şekilde değerler var. Satır sayıları değişiyor. for i to son satır olabilir



İsteğim bu hücredki verileri ayırarak kopyalama ve boş hücrelerden kurtulma

• B sütununa X yada Y VE C sütununa yanındaki değeri yazsın
• Noktaları virgül yapsın Örn : 4.625 > 4,625

Acil yardıma ihtiyacım var arkadaşlar

 

[Asri]

Deneyiniz.

Sub duzenle()
  sonsatir = Cells(Rows.Count, "A").End(3).Row
  Range("B:C").ClearContents
  For i = sonsatir To 1 Step -1
     gec = Cells(i, 1).Value
     If gec = "" Then
        Rows(i).Delete
     Else
        gec = tum_bosluklar_tek_bosluk(gec)
        deger = Split(gec, " ")
        Cells(i, 2) = deger(0)
        Cells(i, 3) = deger(1)
     End If
  Next i
  Columns("C:C").Select
  Selection.NumberFormat = "0.000"
  Range("C2").Select
End Sub

Public Function tum_bosluklar_tek_bosluk(cumle)
  gecici = ""
  eski = "99"
  If InStr(1, cumle, " ") > 0 Then
    For i = 1 To Len(cumle)
      h = Mid(cumle, i, 1)
      If eski <> " " Then
        gecici = gecici + h
      ElseIf eski = " " And h <> " " Then
        gecici = gecici + h
      End If
      eski = h
    Next i
    tum_bosluklar_tek_bosluk = gecici
  Else
    tum_bosluklar_tek_bosluk = cumle
  End If

End Function