notepad'den şartlı veri alma

astek28 · 17 Aralık 2007

arkadaşlar,
notepad üzerinde olan verileri excel dosyasına aktarmak istiyorum. bunun için çeşitli seçenekler olduğunu öğrendim. macro1 ve macro2 olarak örnek macrolar aşağıdadır.

1- öncelikle hangisinin daha performanslı çalıştığından emin değilim.
siz bunlardan hangisini kullanmamı önerirsiniz?

2- asıl problemim ise dakika dakika olan verilerden sadece istenilen bazılarını excel dosyasına aktarmak istiyorum. mesela saat başlarını yada 15 dakikada bir olacak şekilde. bunun için nasıl bir revizyon yapmak gerekli. örnek olacak bir notepad dosyası ektedir.

yardımlarınız için teşekkür ederim.

Sub macro1()
Open "c:\data.txt" For Input As #1
R = 1
While Not EOF(1) 'Scan file line by line
C = 1
Entry = ""
Line Input #1, Buffer
Length = Len(Buffer)
i = 1
While i <= Length 'split comma-delimited string into cells
If (Mid(Buffer, i, 1)) = "," Then
With Application.Cells(R, C)
.NumberFormat = "@" 'Text formatting
.Value = Entry
End With
C = C + 1
Entry = ""
Else
Entry = Entry + Mid(Buffer, i, 1)
End If
i = i + 1
Wend
If Len(Entry) > 0 Then
With Application.Cells(R, C)
.NumberFormat = "@" 'Text formatting
.Value = Entry
End With
End If
R = R + 1
Wend
Close #1
End Sub

Sub macro2()
Worksheets("02").Range("a5: DV750").Clear
ADRES = "TEXT;\\data.txt"
With ActiveSheet.QueryTables.Add(Connection:=ADRES, Destination:=Range("a5"))
.TextFileOtherDelimiter = ";"
.Refresh BackgroundQuery:=False
End With
End Sub

astek28 · 22 Aralık 2007

Gerçekten zor bir problem ile karşı karşıyayım galiba.
Macro dosyadan verileri alırken bu şekilde bir süzme işlemi yapamamakta gibi geliyor bana.

Levent Menteşoğlu · 23 Aralık 2007

Verileri alırken süzme işlemi ilk önerdiğiniz kodda bir düzenleme ile yapılabilir belki, benim fikrim ikinci kodu kullanın ve verileri excele aldıktan sonra tekrar ayıklatın.

astek28 · 23 Aralık 2007

Verileri excele aldıktan sonra süzmede çok fazla veri üzerinde işlem yapılması gerektiğinden dolayı excel'e aktarımdan sonra hesaplamalarda makine oldukça ağırlaşmakta, hatta excel kendini kilitlemekte.
Dolayısı ile verileri alırken seçimli almak istiyorum ama döngüyü oluşturamadım doğrusu!

Levent Menteşoğlu · 23 Aralık 2007

İlk koda aşağıdaki kırmızı kısımları ekledim, bu eklemeyle 15 dakikalık veriler alınmaktadır. Bu mantığa göre kendi istediğiniz kriteri ekleyebilirsiniz.

Kod:

Sub macro1()
Open "c:\data.txt" For Input As #1
R = 1
While Not EOF(1) 'Scan file line by line
c = 1
Entry = ""
Line Input #1, Buffer
Length = Len(Buffer)
i = 1
While i <= Length 'split comma-delimited string into cells
If (Mid(Buffer, i, 1)) = "," Then
With Application.Cells(R, c)
.NumberFormat = "@" 'Text formatting
.Value = Entry
End With
c = c + 1
Entry = ""
Else
Entry = Entry + Mid(Buffer, i, 1)
End If
i = i + 1
Wend
If Len(Entry) > 0 [B][COLOR=red]And Mid(Entry, 15, 2) Mod 15 = 0[/COLOR][/B] Then
[B][COLOR=red]d = d + 1
[/COLOR][/B]With Application.Cells([B][COLOR=red]d[/COLOR][/B], c)
.NumberFormat = "@" 'Text formatting
.Value = Entry
End With
End If
R = R + 1
Wend
Close #1
End Sub

omerceri · 23 Aralık 2007

Sn astek28
Sorunuza Excel'de bir çözüm bulamadım ama Access'te yapğtığım örneği gönderiyorum.
1- Ben Data.txt'i Access'e "aldım" ama siz "bağlıyabilirsiniz" daha esnek olur.
2- Sizin Ofis'iniz ingilizce, 1.alanın dışındakileri metin olarak belirledim, siz sayı olarak dönüştürebilirsiniz.

Zeki Gürsoy · 23 Aralık 2007

Kod:

Sub Veri_Al()
Dim cn     As Object
Dim rs     As Object
Dim myPath As String
Dim i      As Long
Dim j      As Integer

Set cn = CreateObject("ADODB.Connection")

myPath = ThisWorkbook.Path 'TXT dosyasının bulunduğu dizin.

cn.Open _
    "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath & _
    ";Extended Properties=""text;HDR=No;FMT=Delimited"""

Set rs = cn.Execute( _
"SELECT * FROM data.txt")

'Saatbaşı.
'While Not rs.EOF
'    If Minute(rs(0)) = 0 Then
'        i = i + 1
'        For j = 0 To rs.Fields.Count - 1
'            Cells(i, j + 1) = rs(j)
'        Next
'    End If
'rs.movenext
'Wend

'**************************************
'Onbeş ve katı.
While Not rs.EOF
    If Minute(rs(0)) = 15 Or Minute(rs(0)) = 30 Or Minute(rs(0)) = 45 Then
        i = i + 1
        For j = 0 To rs.Fields.Count - 1
            Cells(i, j + 1) = rs(j)
        Next
    End If
rs.movenext
Wend

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

omerceri · 23 Aralık 2007

Sn Anemos'un kodlarındaki
If Minute(rs(0)) = 15 Or Minute(rs(0)) = 30 Or Minute(rs(0)) = 45 Then
satır aşağıdaki gibi değiştirilirse
If Minute(rs(0)) Mod 15 = 0 Then
tam sonuç veriyor.

astek28 · 24 Aralık 2007

arkadaşlar çok teşekkür ederim.
çok güzel olmuş. kafama takılan bir şey için yine sizin bilginize ihtiyaç duymaktayım. sayılar arasında ondalık ayracı olarak , yada ; ayrımını nasıl gösterebilirim?

astek28 · 30 Aralık 2007

Sub Veri_Al()
Dim cn As Object
Dim rs As Object
Dim myPath As String
Dim i As Long
Dim j As Integer

Set cn = CreateObject("ADODB.Connection")

myPath = ThisWorkbook.Path 'TXT dosyasının bulunduğu dizin.

cn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath & _
";Extended Properties=""text;HDR=No;FMT=Delimited"""

Set rs = cn.Execute( _
"SELECT * FROM data.txt")

'Saatbaşı.
'While Not rs.EOF
' If Minute(rs(0)) = 0 Then
' i = i + 1
' For j = 0 To rs.Fields.Count - 1
' Cells(i, j + 1) = rs(j)
' Next
' End If
'rs.movenext
'Wend

'**************************************
'Onbeş ve katı.
While Not rs.EOF
If Minute(rs(0)) Mod 15 = 0 Then
i = i + 1
For j = 0 To rs.Fields.Count - 1
Cells(i, j + 1) = rs(j)
Next
End If
rs.movenext
Wend

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing
End Sub

anemos arkadaşa ve diğer tüm yardımcı arkadaşlara teşekkürler
bu kod mükemmel çalışmakta ancak sayılar ondalıklı olunca ondalık işareti yokmuş gibi davranmakta.yani text dosyasındaki sayılar arasında ondalık ayracı olan "." noktayı görmeden sayıları almakta.
böyle oluncada anlamsız durumlar ortaya çıkıyor.
bu kodda bu olayı çözmek mümkün mü!

Zeki Gürsoy · 30 Aralık 2007

Bilgisayarın "Bölgesel ve Dil Seçenekleri" ni değiştirerek yapılabiliyor.

Kod:

Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" ( _
                                    ByVal Locale As Long, _
                                    ByVal LCType As Long, _
                                    ByVal lpLCData As String) As Boolean
Private Declare Function GetUserDefaultLCID&#37; Lib "kernel32" ()
 
Sub Veri_Al()
Dim cn As Object
Dim rs As Object
Dim myPath As String
Dim i As Long
Dim j As Integer
'**************************************************************
'B&#246;lgesel ayarlar&#305;n de&#287;i&#351;imi
SetLocaleInfo GetUserDefaultLCID(), &HE, "." 'Ondal&#305;k yeni sembol
SetLocaleInfo GetUserDefaultLCID(), &HF, "," 'Binlik yeni sembol
'**************************************************************
Set cn = CreateObject("ADODB.Connection")
myPath = ThisWorkbook.Path 'TXT dosyas&#305;n&#305;n bulundu&#287;u dizin.
cn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath & _
";Extended Properties=""text;HDR=No;FMT=Delimited"""
Set rs = cn.Execute( _
"SELECT * FROM data.txt")
While Not rs.EOF
    If Minute(rs(0)) Mod 15 = 0 Then
        i = i + 1
        For j = 0 To rs.Fields.Count - 1
            Cells(i, j + 1) = rs(j)
        Next
        Cells(i, 1) = CDate(Cells(i, 1))
    End If
rs.movenext
Wend
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
'************************************************
'B&#246;lgesel ayarlar&#305;n eski ayarlara d&#246;n&#252;&#351;&#252;
SetLocaleInfo GetUserDefaultLCID(), &HE, ","
SetLocaleInfo GetUserDefaultLCID(), &HF, "."
'************************************************
End Sub

astek28 · 30 Aralık 2007

süpersin

çok teşekkürler

notepad'den şartlı veri alma

astek28

astek28

Levent Menteşoğlu

Administrator

astek28

Levent Menteşoğlu

Administrator

omerceri

Zeki Gürsoy

Uzman

omerceri

astek28

astek28

Zeki Gürsoy

Uzman

astek28