Karmaşık bir Sayı Metin Ayırma işlemi

[olgunmadak]

Merhaba arkadaşar, iyi günler.

Elimde bir rapor var, bu raporun rtf çıktısını excel ile açamıyoruz malum. ancak txt yaptıktan sonra metin alma yardımcısıyla sütun sütun alabiliyorum onda da problem yok.

Problem şu ki bu değerlerin sırayla dizilmesi gerek. Ama ara satırlarda metinler ve boş satırlar var. Bu metinlerin sıralanmaması gerekiyor.

Forumda aradım ancak tam yöntemi anlayamadım.
Değerlerim şu şekilde geliyor;

Bunu nasıl yapabiliriz ?

 

[Korhan Ayhan]

Merhaba,

Ekteki örnek dosyayı deneyiniz.

Kendi TXT dosyanızda ki yapı farklı ise kodları düzenlemek gerekecektir.

 

[olgunmadak]

Kodları düzenlemek gerekecek sanırım, ancak makro bilgim çok da iyi değil...

örnek raporu paylaşsam ekte yardımcı olabilir misiniz ? Bir de ondalık değerler de çok önemli virgülden sonra 3 basamak gerekiyor. SOnuçların neredeyse hiç birisi tam sayı olmuyor çünkü.

MEAS NOMINAL +TOL -TOL değerleri gerekiyor aynı sırayla.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Option Explicit

Sub Veri_Al()
    Dim Dosya As Variant, Satir As Long, Sutun As Byte
    Dim Kayit As String, Data As Variant
    Dim X As Byte, Y As Byte, Say As Byte, Veri As Variant
    
    Range("A2:D" & Rows.Count).ClearContents
    
    Dosya = Application.GetOpenFilename(FileFilter:="Metin dosyaları(*.txt),(*.txt)", Title:="Bir metin dosyası seçiniz.")
    If Dosya = False Then Exit Sub
    
    Satir = 2
    Sutun = 1
    
    Open Dosya For Input As #1
    Do While Not EOF(1)
        Input #1, Kayit
        If Kayit <> Empty Then
            Say = 0
            If InStr(1, Kayit, "NOMINAL") = 0 Then
                Data = Split(Kayit, " ")
                For X = 0 To UBound(Data)
                    If Data(X) <> "" Then
                        If IsNumeric(Replace(Data(X), ".", ",")) Then
                            Say = Say + 1
                        End If
                        If Say = 6 Then GoTo 10
                    End If
                Next
                        
10
                If Say <> 6 Then GoTo 20
                Say = 0
                For Y = 0 To UBound(Data)
                    If Data(Y) <> "" Then
                        Veri = Replace(Data(Y), ".", ",")
                        If IsNumeric(Veri) Then
                            Say = Say + 1
                            Select Case Say
                                Case 1, 2, 4, 5
                                Cells(Satir, Sutun) = CDbl(Veri)
                                Cells(Satir, Sutun).NumberFormat = "#,##0.000"
                                Sutun = Sutun + 1
                            End Select
                        End If
                    End If
                Next
                
                Sutun = 1
                Satir = Satir + 1
20          End If
        End If
    Loop
    Close #1
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

 

[olgunmadak]

İlginiz için teşekkürler, kusursuz çalışıyor.