Düzensiz verileri hücreleri birleştirerek düzenleme

[relaxim]

https://drive.google.com/open?id=0B_hJhMafxHttb2NoRTVUOVp1eGM

Düzensiz verileri düzenlemek istiyorum.Veriler ayrı sütunlarda olacak sadece ortadaki 2,3 veya 4 kelime metin bir hücrede birleşecek. Anlatmaya çalışayım, ben bu verileri pdf olarak alıyorum.Oradan excele kopyalıyorum. Bunu sürekli yapacağım. Sayfanın görünmeyen bir yerine yapıştırıp, sol başta düzenlenmiş verileri görmek işlem yapmak istiyorum. Yardımlarınız için şimdiden teşekkürler.

 

[YUSUF44]

Dosyanız exe uzantılı olarak göründüğü için indirmedim. Muhtemelen sitenin aldatmacası ve indirince hiç hoş şeyler olmayacak. Daha düzgün bir siteye yükler misiniz (google drive gibi)?

 

[relaxim]

Yusuf Bey google drive ile yükledim. Saygılarımla.

 

[YUSUF44]

Orda da exe uzantılı görünüyor. Muhtemelen bilgisayarınız virüslü.

 

[relaxim]

Yusuf Bey merhaba,

Bilgisayarımda lisanslı antivürüs prg. mevcuttur. Altın üyelik için bakacağım.

 

[YUSUF44]

Merhaba. Sorunun altın üyelikle çözüleceğini sanmıyorum.

Yüklediğiniz dosyanın uzantısı exe, altın üyelik de olsa aynı dosyayı yükleyeceksiniz.

Muhtemelen bilgisayarınızdaki virüsün farkında değilsiniz. Yerinizde olsam Windows gezgininde dosya uzantılarını göstermeyi aktif eder ve dosyaları öyle incelerdim.

Sizi ve arkadaşları da uyarayım: aslında excel, word gibi belge dosyası olan ancak uzantısı exe olan bir dosyayı kesinlikle yüklemeyin ve çalıştırmayın.

https://www.google.com.tr/search?q=dosya+uzantısı+exe+oldu&oq=dosya+uzantısı+exe&aqs=chrome.1.69i57j0l5.8569j0j7&sourceid=chrome&ie=UTF-8

 

[relaxim]

Yusuf Bey merhaba, sorunun kaynağını buldum. Rar ile sıkıştırırken skf arşivi oluştur seçeneği işaretli olduğu için exe uzantılı olmuş. Şimdi tekrar yükledim, dener misiniz. Ayrıca altı üye oldum.Saygılarımla.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub AKTAR()
    Dim Son As Long, X As Byte, Y As Byte, Satir As Long
    
    Application.ScreenUpdating = False
    
    Range("A2:K" & Rows.Count).Clear
    Son = Cells(Rows.Count, "N").End(3).Row
    Satir = 2
    
    For X = 2 To Son
        Cells(Satir, 1) = Cells(X, 14)
        Cells(Satir, 2) = Cells(X, 15)
        Cells(Satir, 3) = Cells(X, 16)
        
        For Y = 17 To 27
            If IsDate(Cells(X, Y)) Then
                Cells(Satir, 5) = CDate(Cells(X, Y))
                Exit For
            Else
                Cells(Satir, 4) = IIf(Cells(Satir, 4) = "", Cells(X, Y), Cells(Satir, 4) & " " & Cells(X, Y))
            End If
        Next
        
        Cells(Satir, 6) = Cells(X, Y + 1)
        Cells(Satir, 7) = Cells(X, Y + 2)
        Cells(Satir, 8) = Cells(X, Y + 3)
        Cells(Satir, 9) = Cells(X, Y + 4)
        Cells(Satir, 10) = Cells(X, Y + 5)
        Cells(Satir, 11) = Cells(X, Y + 6)
        Satir = Satir + 1
    Next

    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[relaxim]

Korhan Bey harika görünüyor. Ellerinize sağlık. Biraz daha deneyeceğim. Saygılarımla.

 

[relaxim]

Korhan Bey merhaba,
Pdf den kopyalarken hepsini baştaki hücrelere kopyalıyor. Aşağıdaki verilerin hepsi aynı sütunda. Ben de metni sütunlara dönüştürüyorum. Buna gerek kalmadan olabilir mi? Bu şekilde olduğunda ne yapabiliriz. Sizleri yorduğum için kusura bakmayınız.



00010 H410-1113 R0 SICAK SU BORUSU 26.06.2017 1 ADT 27,00 TRY 27,00 TRY
00020 H410-1112 R0 SICAK SU BORUSU 26.06.2017 1 ADT 25,00 TRY 25,00 TRY
00030 H410-1110 R0 SICAK SU BORUSU 26.06.2017 1 ADT 25,00 TRY 25,00 TRY
00040 H410-1109 R0 SICAK SU BORUSU 26.06.2017 2 ADT 32,00 TRY 64,00 TRY
00050 H410-1082 R0 XD28 Sıcak Su Borusu 26.06.2017 4 ADT 28,00 TRY 112,00 TRY
00060 H410-1077 R0 XD28 Sıcak Su Borusu 26.06.2017 3 ADT 57,00 TRY 171,00 TRY
00070 H410-1076 R0 XD28 Sıcak Su Borusu 26.06.2017 4 ADT 57,00 TRY 228,00 TRY
00080 H410-1061 R0 XSICAK SU BORUSU 26.06.2017 2 ADT 40,00 TRY 80,00 TRY
00090 H410-1060 R0 XSU BORUSU 26.06.2017 2 ADT 38,00 TRY 76,00 TRY
00100 H410-1059 R0 XSU BORUSU 26.06.2017 2 ADT 10,00 TRY 20,00 TRY
00110 H410-1058 R0 XSICAK SU BORUSU 26.06.2017 2 ADT 16,00 TRY 32,00 TRY
00120 H410-1057 R0 XSICAK SU BORUSU 26.06.2017 3 ADT 45,00 TRY 135,00 TRY
00130 H410-1056 R0 XSU BORUSU 26.06.2017 3 ADT 25,00 TRY 75,00 TRY
00140 H410-1055 R0 XSU BORUSU 26.06.2017 2 ADT 21,00 TRY 42,00 TRY
00150 H410-1054 R0 XSICAK SU BORUSU 26.06.2017 2 ADT 21,00 TRY 42,00 TRY
00160 H410-1053 R0 XSICAK SU BORUSU 26.06.2017 2 ADT 13,00 TRY 26,00 TRY
00170 H410-1043 R0 XSU BORUSU 26.06.2017 1 ADT 34,31 TRY 34,31 TRY
00180 H410-1019 R0 XSU BORUSU 26.06.2017 4 ADT 22,79 TRY 91,16 TRY
00190 H410-1017 R0 XSU BORUSU 26.06.2017 4 ADT 35,11 TRY 140,44 TRY
00200 H410-1012 R0 XSU BORUSU 26.06.2017 2 ADT 32,77 TRY 65,54 TRY
00210 H410-1011 R0 XSU BORUSU 26.06.2017 2 ADT 28,15 TRY 56,30 TRY
00220 H410-1010 R0 XSU BORUSU 26.06.2017 2 ADT 6,00 TRY 12,00 TRY
00230 H410-1009 R0 XSICAK SU BORUSU 26.06.2017 2 ADT 11,00 TRY 22,00 TRY

 

[relaxim]

Yardımcı olabilir misiniz?

 

[relaxim]

Konu güncel...

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Option Explicit

Sub AKTAR()
    Dim Sayi As Byte, Veri As Variant, Son As Long, X As Byte, Satir As Long, Y As Byte, Z As Byte
    
    Application.ScreenUpdating = False
    
    Sayi = Application.InputBox("Verileriniz kaç sütundan oluşuyor?" & Chr(10) & Chr(10) & "Tek sütun için 1 yazınız." & Chr(10) & "Çoklu sütun için 2 yazınız.", "Microsoft Excel", 1)
    
    Range("A2:K" & Rows.Count).Clear
    Son = Cells(Rows.Count, "N").End(3).Row
    Satir = 2
    
    If Sayi = 1 Then
        For X = 2 To Son
            If Cells(X, 14) <> "" Then
                Veri = Split(Cells(X, 14), " ")
                For Y = 0 To UBound(Veri)
                    Cells(Satir, 1) = Veri(Y)
                    Cells(Satir, 2) = Veri(Y + 1)
                    Cells(Satir, 3) = Veri(Y + 2)
                
                    For Z = 3 To UBound(Veri)
                        If IsDate(Veri(Z)) Then
                            Cells(Satir, 5) = CDate(Veri(Z))
                            Exit For
                        Else
                            Cells(Satir, 4) = IIf(Cells(Satir, 4) = "", Veri(Z), Cells(Satir, 4) & " " & Veri(Z))
                        End If
                    Next
                    
                    Cells(Satir, 6) = Veri(Z + 1)
                    Cells(Satir, 7) = Veri(Z + 2)
                    Cells(Satir, 8) = CDbl(Veri(Z + 3))
                    Cells(Satir, 9) = Veri(Z + 4)
                    Cells(Satir, 10) = CDbl(Veri(Z + 5))
                    Cells(Satir, 11) = Veri(Z + 6)
                    Satir = Satir + 1
                    GoTo 10
                Next
            End If
10
        Next

    ElseIf Sayi = 2 Then
        For X = 2 To Son
            Cells(Satir, 1) = Cells(X, 14)
            Cells(Satir, 2) = Cells(X, 15)
            Cells(Satir, 3) = Cells(X, 16)
            
            For Y = 17 To 27
                If IsDate(Cells(X, Y)) Then
                    Cells(Satir, 5) = CDate(Cells(X, Y))
                    Exit For
                Else
                    Cells(Satir, 4) = IIf(Cells(Satir, 4) = "", Cells(X, Y), Cells(Satir, 4) & " " & Cells(X, Y))
                End If
            Next
            
            Cells(Satir, 6) = Cells(X, Y + 1)
            Cells(Satir, 7) = Cells(X, Y + 2)
            Cells(Satir, 8) = Cells(X, Y + 3)
            Cells(Satir, 9) = Cells(X, Y + 4)
            Cells(Satir, 10) = Cells(X, Y + 5)
            Cells(Satir, 11) = Cells(X, Y + 6)
            Satir = Satir + 1
        Next
    End If

    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[relaxim]

Korhan Bey ellerinize sağlık. Siz fazladan seçenekli yapmışsınız. Sanırım seçeneğe gerek kalmayacak. Veriler sadece N sütununda olacak. Ben sizin kodlarda düzenleme yaparak seçeneği kaldırmaya çalışacağım. Her şey için teşekkürler....