Dat uzantılı dosyadan veri kopyalama

[xternet]

Merhaba arkadaşlar.

Yapmak istediğim işlem için forumda arama yaptım ama örneklerin çoğu excelden veri alma ile ilgili.
Ben dat uzantılı bir dosyadaki tüm karakterleri kopyalayıp excel sayfasında bir hücreye yapıştırmak istiyorum.
Şöyle ki:
Excel sayfasında kodu atadığım butona tıkladığımda benden bilgisayarımda bulunan dat dosyasının yolunu isteyecek ve ben dosyayı gösterdiğimde, içindeki tüm verileri ilk karakterden son karaktere kadar kopyalayıp exceldeki tek hücreye (hücre sabit, A5 mesela) yapıştıracak ve sonlanacak.

Vakit ayırıp ilgilenecek arkadaşlara şimdiden teşekkür ediyorum.



Ayrıca çokça bilgilendiğim ve exceldeki tüm çalışmalarımda destek aldığım bu forum ortamına ve yöneticilerine de ayrıca teşekkür ederim. Bu kadar faydalı ve uzun soluklu başka bir forum ortamı olduğunu sanmıyorum.
İyi çalışmalar.

 

[ogameci]

dat dosyasını sağ tık ile birlikte aç tıklayın notepad ile açın, içeriğini kopyalayın, Excel'e yapıştırın.
Ancak her satır için bir Excel satırı kullanılır.

 

[xternet]

Alakanız için teşekkürler Sayın ogameci.
Manuel olarak dediğiniz gibi yapıyorum. Yalnız bazen 700-800 satır söz konusu. Bu kopyalama işlemini kodla yapabilir miyim diye düşünmüştüm.

 

[ogameci]

Şu makroyu deneyin (alıntıdır)

Sub Openfile_copy_paste_close()
Dim LastRow As Long
Dim origwb As Object 'original file
Set origwb = ActiveWorkbook
Dim newsheet As Worksheet 'this will be newsheet in orig file

Dim otherfileName As String
Application.ScreenUpdating = False
otherfileName = Application.GetOpenFilename(FileFilter:="DAT Files (*.dat),*.dat", _
Title:="Dosya seçin.", _
MultiSelect:=False)

'Dosya açılamıyor. Kontrol edin.
If otherfileName = "False" Then GoSub No_File_Chosen
' MsgBox "Açılan dosya: " & otherfileName

Workbooks.Open otherfileName, Format:=2
Dim otherfile As Object
Set otherfile = ActiveWorkbook 'capture otherfile as an object because some calls will not work with string datatype.
'Cells.Select
'Selection.Copy
UsedRange.Copy
Windows(origwb.Name).Activate
'Add new sheet to orig-file to receive paste:
'Set newsheet = Sheets.Add(Type:=xlWorksheet)
'newsheet.Name = "sheet name" 'Could choose to rename the sheet if desired
Range("A7").Select
'Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False 'eliminates prompt for keeping the copy-buffer on close
otherfile.Close savechanges:=False

Range("A6").Select
ActiveCell.FormulaR1C1 = "TWACS MOD #"
Range("B6").Select
ActiveCell.FormulaR1C1 = "DATE & TIME"
Range("C6").Select
ActiveCell.FormulaR1C1 = "NUM OF BLINKS"
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("A:C").Select
Selection.ColumnWidth = 24#
Range("A6:C6").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With

Range("A7").Select
Application.ScreenUpdating = True

Exit Sub

No_File_Chosen:
MsgBox "You did not select any file. Nothing will be imported."
End Sub

 

[xternet]

Kod yeni bir çalışma kitabının a1 hücresinden aşağı verileri yapıştırdı ve resimdeki hatayı vererek durdu. Benim çalışmamda herhangi bir değişiklik olmadı. Açılan çalışma kitabının adı ve sekme adı, verileri aldığım dosyanın adı olarak açıldı.

Sayın ogameci;
Ben basit bir kod ile halledilebilir düşüncesiyle sormuştum. Eğer karmaşık ve uğraştıracak bir yapısı varsa vaktinizi almayayım. Dediğiniz gibi manuel olarak yapılabiliyor.

 

[Haluk]

Merhaba;

Bir tane örnek DAT dosyası eklerseniz, üzerinde uğraşalım.

Ayrıca, DAT dosyasındaki bütün verilerin sayfada tek bir hücreye mi yerleştirimesini istiyorsunuz, yoksa; alt alta hücrelere mi yazılsın ?

Bunu da tekrar teyit ederseniz iyi olur.

.

 

[xternet]

Alt alta yapıştıracak Haluk bey.
Manuel olarak tüm verileri kopyalayıp tek bir hücreye yapıştırınca da alt alta yapıştırıyor.
Hedefimiz resimde görülen T11 hücresi. Sonrasında excel alt alta diziyor zaten.

Dat dosyası içerisindeki veriler test sınavı sonuçlarının ham hali. Ben bu verileri excel e aktardıktan sonra ayıklayıp sınav sonuçlarını ve analizlerini oluşturuyorum.

Dat örneğini akledim.

 

[Merhum İdris SERDAR]

.

Alındığında böyle olsun derseniz, nasıl yapıldığını anlatayım.


.

 

[xternet]

Alındıktan sonrasında sorun yok İdris bey, Yani her satır tek hücreye kopyalansa yeter.
Ayıklama işlemini yaptırdım.

 

[Merhum İdris SERDAR]

.

Aslında nasıl alındığını anlatacaktım.

işte bu da her satır bir hücreye.

Bu mudur?

.

 

[xternet]

İdris bey sanırım yanlış ifade ettim.
Sonuç bu. Amaç bu işlemi kod ile dat dosyasının yolunu göstererek yaptırmak.

 

[Merhum İdris SERDAR]

.

Aslında makro koduna gerek kalmadan da yapmak mümkün. Ancak kod istediğiniz için kodu veriyorum.

DAT dosyasını seçme olanağı sağlayan bir kod.

Sub Verial()

    Application.ScreenUpdating = False
    Dim sec As Integer
    Dim yol As String

    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    
    sec = Application.FileDialog(msoFileDialogOpen).Show
    
    If sec <> 0 Then
        
        yol = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    End If
    
    On Error GoTo hata
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & yol, Destination:=Range("$A$2"))
        .Name = "MemoQ Data Range"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    Application.ScreenUpdating = True
    Exit Sub

hata:
    Exit Sub
    
End Sub

Dosyanız ekte.


.

 

[Haluk]

Alternatif:

Aslında DAT dosyasındaki verilerin nasıl bölündüğünü bilsek iyi olurdu ama, sadece varsayımda bulunarak aşağıdaki kodu hazırladım.

Sub GetTxtData()
    Dim MyFile As Variant
    MyFile = Application.GetOpenFilename("DAT Dosyaları ,*.dat")
    If MyFile <> False Then
        Open MyFile For Input As #1
            Do While Not EOF(1)
                i = i + 1
                Line Input #1, InputData
                Cells(i, 1) = Mid(InputData, 6, 16)
                Cells(i, 2) = Mid(InputData, 22, 1)
                Cells(i, 3) = Mid(InputData, 23, 6)
                Cells(i, 4) = Mid(InputData, 29, 5)
                Cells(i, 5) = Mid(InputData, 34, 10)
                Cells(i, 6) = Mid(InputData, 44, 30)
                Cells(i, 7) = Mid(InputData, 90, 30)
            Loop
        Close #1
    End If
    Columns.AutoFit
End Sub

 

[xternet]

İdris bey;
Kod, sayfa korumalı iken çalışmıyor.(Yapıştırılacak alan korumasız)
Koruma yokken de sayfa yapısını bozuyor. Yani yapıştırdığı sutunu oldukça fazla genişletiyor.
Ayrıca eğer makro kodu olmadan çözüm varsa tabii ki oda olur. Hatta daha güzel olur.

Haluk bey;
Sizin kodda koruma varken çalışmıyor. Koruma yokken de her bir satırı yaklaşık 1 saniyede alıyor ve aktarım bittiğinde yine sayfa düzeni aşırı bozuluyor.

Verilerin bölünmesi işlemini excel formülleriyle yapıyorum. Test sınavlarında kullanılan optik formların formatları farklılık gösterdiği için çalışmanın bir bölümünde optik formun karakter dizilişini işliyorum. Girdiğim formüller buna göre satırları ayıklıyor.

 

[Merhum İdris SERDAR]

.

1. Kodun başına koruma kaldırmak için:

ActiveSheet.Unprotect password:="1234"

Tekrar koymak için kodun en sonuna:

ActiveSheet.Protect password:="1234"

kodlarını ekleyin.

2.

.AdjustColumnWidth = True

kodunu,

.AdjustColumnWidth = [COLOR="Red"]False[/COLOR]

şeklinde kullanırsanız, sütun genişliğine dokunmaz.

3. Makro olmadan İngilizcelerini veriyorum.

Data > Get External Data > From Text

Dosyayı seçtikten sonra yönergeleri takip edin.

.

 

[xternet]

İdris bey, dediğiniz düzenleme ile sorun çözüldü. Zihninize ve elinize sağlık.

Yalnız bir şeyi daha sormak istiyorum.
Programın işleyişinde verileri yapıştırdığımız "T11" hücresi boş oluyor ama denemeler yaparken
"T11" dolu iken kodu çalıştırdığımda, kod T nin soluna U sutunu ekleyip U11 den aşağı yapıştırdı.
Bu da sayfanın düzenini bozuyor tabiki.
Dediğim gibi bu durum (yani T11 in dolu olması) pek olası bir durum değil ama bu sutun ekleme işlemi neden kaynaklanıyor olabilir?

 

[Merhum İdris SERDAR]

.

T11 boş bırakın.

Veya.

Kazaya kurban gitmemek için alanımızı temizlemek için kodların başına:

Cells.Select
    Selection.QueryTable.Delete
    Selection.Clear
    Range("A3").Select

gibi bir kod koyun.

.

 

[xternet]

T11 e aldığım verileri işleme sayfasına aktarırken temizleme işlemi yaptırıyordum.
"Selection.QueryTable.Delete" kodunu da silme koduma eklemiştim.
Dediğiniz gibi sizin kodların başına bu kodu eklediğimde iş riske kalmamış olur.

Tekrar her şey için teşekkür ederim.
İyi çalışmalar.