• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

txt den excele veri çekişinde sorun

Birde bu kodu denermisiniz.
 
Hocam sizi yoruyoruz hakkını helal et
Malesef bu kodlarda yanlış verileri getiriyor
Hocam ekli kloserde excel dosyasında Aktar ve Aktar2 sayfaları birde txt kloseri var konunun iyi anlaşılması Aktar ve Aktar2 sayfalarındaki aktar butonuna basıp txt klosöründeki verileri aktarıp gelen verileri karşılaştıra bilirmisiniz zahmet olmassa
Ayrıca Aktar sayfasındada açıklama yaptım
 

Ekli dosyalar

Halit Hocam
Sanırım sorunu çözdüm
Kodlarda yeşil boyalı kodları pasif edip
kırmızı boyalı kodları ekledim
İnceleyebilirmisiniz
sorun olabilecek bir şey varmı?
Başka pasif edeceğimiz kodlar varmı(etkisi olmayan)?
Yorum yapabilirmisiniz?

Dim Klasor As Object
Dim Obj As Object
Dim Kaynak As String
Dim Hedef As String
Dim sat1 As String
Dim sat As String
Private Sub CommandButton1_Click()
On Error Resume Next
Range("A:V").ClearContents
Range("A:V").NumberFormat = "@"
sat1 = 2
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.BrowseForFolder(0, Baslik, 50, &H0)
Kaynak = Klasor.Items.Item.Path
If Not Klasor Is Nothing Then
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
Application.ScreenUpdating = False
Liste (Kaynak)
Application.DisplayAlerts = True
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Obj = Nothing
Set Klasor = Nothing
Exit Sub
Hata: MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
End Sub
Private Sub Liste(Yol As String)

Dim aranan(8)
aranan(1) = "C.70.1": aranan(2) = "1.8.0*": aranan(3) = "1.8.1*":
aranan(4) = "1.8.2*": aranan(5) = "1.8.3*": aranan(6) = "5.8.0*":
aranan(7) = "8.8.0*": aranan(8) = "1.6.0*":
Dim say, a, son1, b, t, y, sut2

Dim aranan2(500)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").getfolder(Yol).SubFolders
Dosya = Dir(Yol & "\*.**")

Do While Dosya <> ""
DoEvents
sat = sat1
If Right(Dosya, 4) = ".txt" Or Right(Dosya, 3) = ".tbr" Then
Cells(sat, 1).Value = Dosya
i = 2
j = 0
'sut2 = 3
Open (Yol & "/" & Dosya) For Input As #1
Do While Not EOF(1)
Line Input #1, a
j = j + 1
aranan2(j) = ""
aranan2(j) = a
Loop
Close
sut2 = 3
For m = 1 To 8
For i = 1 To j
For n = 1 To Len(aranan2(i))
If Mid(aranan2(i + 1), n, Len(aranan(m))) = aranan(m) Then
deg1 = 0
deg2 = 0
For t = 1 To Len(aranan2(i + 1))
If Mid(aranan2(i + 1), t, 1) = "(" Then
deg1 = t
End If
If Mid(aranan2(i + 1), t, 1) = ")" Then
deg2 = t
Exit For
End If
Next
yer = ""
yer2 = ""
For y = deg1 To deg2
If IsNumeric((Mid(aranan2(i + 1), y, 1))) = True Or (Mid(aranan2(i + 1), y, 1)) = "." Then
yer = yer & (Mid(aranan2(i + 1), y, 1))
End If
If IsNumeric((Mid(aranan2(i + 1), y, 1))) = True Then
yer2 = yer2 & (Mid(aranan2(i + 1), y, 1))
End If
Next

If Trim(yer) <> "" Then
'Cells(sat, sut2).Value = yer
Cells(sat, m + 2).Value = yer
i = j
sut2 = sut2 + 1
End If
'End If
End If
Next
Next
Next


End If
sat = sat + 1
sat1 = sat
Dosya = Dir
Loop

On Error GoTo sonraki
For Each f In fL
Kaynak = f.Path
Liste (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub
 

Ekli dosyalar

numan şamil' Alıntı:
Halit Hocam
Sanırım sorunu çözdüm
Kodlarda yeşil boyalı kodları pasif edip
kırmızı boyalı kodları ekledim
İnceleyebilirmisiniz
sorun olabilecek bir şey varmı?
Başka pasif edeceğimiz kodlar varmı(etkisi olmayan)?
Yorum yapabilirmisiniz?
Genişletmek için tıkla ...

21 nolu mesajdaki kodları aynen hiç kullanmadığınız anlaşılıyor.
 
halit3' Alıntı:
21 nolu mesajdaki kodları aynen hiç kullanmadığınız anlaşılıyor.
Genişletmek için tıkla ...

Merhaba Halit bey
21. nolu mesajındaki kodları 22 nolu mesajımın ekli dosyasında aktar2 sayfasında kullandım
Sadece
aranan(1) = "C.70.1": aranan(2) = "1.8.0": aranan(3) = "1.8.1":
aranan(4) = "1.8.2": aranan(5) = "1.8.3": aranan(6) = "5.8.0":
aranan(7) = "8.8.0": aranan(8) = "1.6.0":
yerine aranan kriter örn:1.8.1* oduğu için

aranan(1) = "C.70.1": aranan(2) = "1.8.0*": aranan(3) = "1.8.1*":
aranan(4) = "1.8.2*": aranan(5) = "1.8.3*": aranan(6) = "5.8.0*":
aranan(7) = "8.8.0*": aranan(8) = "1.6.0*":
şeklinde değiştirerek kullandım
bu benim hatam
Aslında hiç değiştirmeden denedim
Ancak
Kırmızı ile yazılı rakamların gelmemesi gerek mektedir
bunun için değiştirdim fakat olmadı taktir ederseniz kodlardan anlamıyorum
kodlara
kriter olarak 1.8.1.*50 şeklinde yazamıyorum 50 sayısıda değişken

x firması.txt 37119406 50181235,495 50103613,122 5027566,208 5050056,164 504914,231 503633,597 5012,10
y firması.txt 37119406 48172137,838 4898501,387 4826210,498 4847425,953 484707,410 483500,239 4812,06
z firması.txt 37119408 5019,812 5018,199 500,015 501,474 500,05

gelmesi gereken veriler aşağıdaki gibi
x firması.txt 37119406 181235.495 103613.122 27566.208 50056.164 4914.231 3633.597 12.10
y firması.txt 37119406 172137.838 98501.387 26210.498 47425.953 4707.410 3500.239 12.06
z firması.txt 37119408 19.812 18.199 0.015 1.474 0.05

Kusura bakmayın verdiğiniz kodları denemeden kafama göre işlem yapıyorum gibi bir şey aklınıza gelmesin.
Ancak olay öyle karmaşıkki ifade etmekte çok zorlanıyorum
Şimdide

23 nolu mesajdaki kodlar normal çalışıyor
Fakat
txt nesnesinin x firmasına ait
1.8.1*50(103613.122*MWh)
Satırını sildiğm zaman
Aynı nesne içerisinde bulunan
S-1.8.1*50(103630.522*MWh)
103630.522
veriyi getiriyor
21 nolu mesajınızdaki kodlar hemde 22 nolu mesajımdaki kodlar bu şekilde yapıyor
bunuda yeni fark ettim bu veri gelmemesi bunun yerinin boş kalması için ne yapabiliriz?
Hocam sizi üzdüysem kusura bakma Hakkını helal et
 
Son düzenleme:
numan şamil' Alıntı:
Merhaba Halit bey
21. nolu mesajındaki kodları 22 nolu mesajımın ekli dosyasında aktar2 sayfasında kullandım
Sadece
aranan(1) = "C.70.1": aranan(2) = "1.8.0": aranan(3) = "1.8.1":
aranan(4) = "1.8.2": aranan(5) = "1.8.3": aranan(6) = "5.8.0":
aranan(7) = "8.8.0": aranan(8) = "1.6.0":
yerine aranan kriter örn:1.8.1* oduğu için

aranan(1) = "C.70.1": aranan(2) = "1.8.0*": aranan(3) = "1.8.1*":
aranan(4) = "1.8.2*": aranan(5) = "1.8.3*": aranan(6) = "5.8.0*":
aranan(7) = "8.8.0*": aranan(8) = "1.6.0*":
şeklinde değiştirerek kullandım
bu benim hatam
Aslında hiç değiştirmeden denedim
Ancak
x firması.txt 37119406 50181235,495 50103613,122 5027566,208 5050056,164 504914,231 503633,597 5012,10
y firması.txt 37119406 48172137,838 4898501,387 4826210,498 4847425,953 484707,410 483500,239 4812,06
z firması.txt 37119408 5019,812 5018,199 500,015 501,474 500,05


x firması.txt 37119406 181235.495 103613.122 27566.208 50056.164 4914.231 3633.597 12.10
y firması.txt 37119406 172137.838 98501.387 26210.498 47425.953 4707.410 3500.239 12.06
z firması.txt 37119408 19.812 18.199 0.015 1.474 0.05
Genişletmek için tıkla ...

Bundan ben birşey anlamadım.

kırmızı yerler fazlamı.?
 
numan şamil' Alıntı:
Bana gerekli olan veri
1.8.1*50(103613.122*MWh)
Sadece
Parantez içerisindeki sayısal veri olan (103613.122) dir
Genişletmek için tıkla ...

21 nolu mesajdaki kodları güncelledim.

Aktar sayfasındaki bütün kodları onunla değiştirin.
 
halit3' Alıntı:
21 nolu mesajdaki kodları güncelledim.

Aktar sayfasındaki bütün kodları onunla değiştirin.
Genişletmek için tıkla ...

Halit bey son kodlarınız istediğim gibi çalışıyor ellerine sağlık
çok önemli olmamakla birlikte ufak bir sorun var bu nitelikte olan txt dosya sayısı az eğer zor olmayacaksa
25.mesajın sonundada belirttiğm gibi
txt nesnesinin x firmasına ait
1.8.1*50(103613.122*MWh)
Satırını sildiğim zaman
Aynı nesne içerisinde bulunan
S-1.8.1*50(103630.522*MWh)
103630.522
Ekli dosyada olduğu gibi
veriyi getiriyor
bu verinin gelmemesi bunun yerinin boş kalması için ne yapabiliriz?
Olmuyorsa bu haliylede çok işme yarıyor
Allah razı olsun
 

Ekli dosyalar

numan şamil' Alıntı:
Halit bey son kodlarınız istediğim gibi çalışıyor ellerine sağlık
çok önemli olmamakla birlikte ufak bir sorun var bu nitelikte olan txt dosya sayısı az eğer zor olmayacaksa
25.mesajın sonundada belirttiğm gibi
txt nesnesinin x firmasına ait
1.8.1*50(103613.122*MWh)
Satırını sildiğim zaman
Aynı nesne içerisinde bulunan
S-1.8.1*50(103630.522*MWh)
103630.522
Ekli dosyada olduğu gibi
veriyi getiriyor
bu verinin gelmemesi bunun yerinin boş kalması için ne yapabiliriz?
Olmuyorsa bu haliylede çok işme yarıyor
Allah razı olsun
Genişletmek için tıkla ...

En başta söylemiştim bu işlemler baya karışık verilerin hiç biri birbirine uymuyor.
Kodun içindeki bu bölümü
Kod: 
If a > 0 Then
bununla bir değiştirn ne sonuç alacaksınız.
Kod: 
If a =1 Then
 
halit3' Alıntı:
En başta söylemiştim bu işlemler baya karışık verilerin hiç biri birbirine uymuyor.
Kodun içindeki bu bölümü
Kod: 
If a > 0 Then
bununla bir değiştirn ne sonuç alacaksınız.
Kod: 
If a =1 Then
Genişletmek için tıkla ...

Dediğiniz gibi veriler bir birini tutmuyor
Kodu değiştirip denedim
x firması txt nesnesinde istediğim gibi oluyor
Diğer bazı txt nesnelerin
Örn: 23. mesajdaki ekli dosyada txt de y firmasına ait txt nesnesinde olduğu için gibi
C.70.1(37119406) kısmındaki C 'nin önünde küçük diktörtgen gibi birşey var galiba bu yüzden bu veriyi almıyor
Bazı txt dosyalarında bu yok Böyle olan veriyi alıyor
yapılacak bir şey yok
En azından If a =1 Then kodun ne işe yaradığını öğrenmiş oldum
Teşekkür ederim
iyi çalışmalar
 
Son düzenleme:
numan şamil' Alıntı:
Dediğiniz gibi veriler bir birini tutmuyor
Kodu değiştirip denedim
x firması txt nesnesinde istediğim gibi oluyor
Diğer bazı txt nesnelerin
Örn: 23. mesajdaki ekli dosyada txt de y firmasına ait txt nesnesinde olduğu için gibi
C.70.1(37119406) kısmındaki C 'nin önünde küçük diktörtgen gibi birşey var galiba bu yüzden bu veriyi almıyor
Bazı txt dosyalarında bu yok Böyle olan veriyi alıyor
yapılacak bir şey yok
En azından If a =1 Then kodun ne işe yaradığını öğrenmiş oldum
Teşekkür ederim
iyi çalışmalar
Genişletmek için tıkla ...

Kodun yaptığı işlem örnek (C.70.1)olarak söylüyorum,
bu değeri bulduğu zaman sol tarafta ne olursa olsun sol tarafına bakmaz sağ tarafta ilk açık ( parantezi buluyor ve daha sonra kapalı ilk ) parantezi buluyor ve içindeki sayı değerlerini alıyor.
 
Merhaba ekli dosyada son kodlarınızda
If a =1 Then olarak değiştirdim
birde txt dosyası ekli
verileri aktardığımda sadece kopyası x firmasına ait E2 ve G2 hücrelerinin boş olması gerekiyor
Bu txt nesnesi ve diğerlerine ait başka hiç bir hücre boş olmamalı ekteki örneği
If a =1 Then haliyle birde If a > 0 Then haliyle deneyebilirseniz dediğim daha iyi anlaşılacaktır
Bunun neden kaynaklandığını bilemiyorum
Tabii vaktiniz varsa
 

Ekli dosyalar

Son düzenleme:
numan şamil' Alıntı:
Merhaba ekli dosyada son kodlarınızda
If a =1 Then olarak değiştirdim
birde txt dosyası ekli
verileri aktardığımda sadece kopyası x firmasına ait E2 ve G2 hücrelerinin boş olması gerekiyor
Bu txt nesnesi ve diğerlerine ait başka hiç bir hücre boş olmamalı ekteki örneği
If a =1 Then haliyle birde If a > 0 Then haliyle deneyebilirseniz dediğim daha iyi anlaşılacaktır
Bunun neden kaynaklandığını bilemiyorum
Tabii vaktiniz varsa
Genişletmek için tıkla ...

Demekki tam açıklamak gerekiyor bu durumu
örnek1 aranan(3) = "1.8.1":

kırmızı işaretli yer Kopyası x firması.txt dosyasında tam üç yerde geçiyor yani
5 satır,30 satır,31 satırlarda geçiyor

1.8.1(103627.460*MWh)
S-1.8.1(103644.862*MWh)
S-1.8.1*50(103630.522*MWh)

örnek 2 aranan(1) = "C.70.1"

Örnek2 deki kod ilk bulduğu veriyi alıyor ve diğerlerine bakmıyor.
Örnek1 deki kod ikinci veriyi buluyor ve onu alıyor diğerlerine bakmıyor eğer ikinci veri yoksa boş geçiyor.

çünkü belli bir standardınız yok bir dosyada ilk veri doğruyken diğer dosyanızda ortadaki veya son veri doğru olabiliyor.
 
Bu örnek dosyada sayfa1 de kod ile gelen verileri ben sıra numarasını ve değerini yazarak hücreyi renklendirdim.

Sizce olması gerekeni de sayfa2 de hücreyi renklendirerek sıra numarasını ve değerini yan hücrelere yazın bir bakalım.
aslında ta en başta böyle birşey yapmak gerekiyordu.
 
Birde bu dosyaya bakın
 
halit3' Alıntı:
Bu örnek dosyada sayfa1 de kod ile gelen verileri ben sıra numarasını ve değerini yazarak hücreyi renklendirdim.

Sizce olması gerekeni de sayfa2 de hücreyi renklendirerek sıra numarasını ve değerini yan hücrelere yazın bir bakalım.
aslında ta en başta böyle birşey yapmak gerekiyordu.
Genişletmek için tıkla ...

Hocam dediğniz gibi ekli dosyada Sayfa2 'yi doldurdum
Oradada görüleceği gibi 1.8 'li olanlarda Hepsinde
1.8.1* sonunda "*" olan verileri alması gerekiyor
Onun için kodlarda aranan kısmına
"*" eklemiştim
"*" olmayan veriyi almayacak

Bir tek istisna olan
C.70.1(37119406) olan veriyi almam gerekiyor
Birde
S-1.8.1* Başında S- olan veriler alınmayacak
36. mesajınızdaki dosyanızı inceledim bir şey hariç güzel çalışıyor
oda örneğin
1.8.1 satırını (sonunda"*" olmayan ) sildiğimdeki bu veriyi zaten almaması gerekiyor
hemen onun altında asıl alması gereken
1.8.1* veriyi boş geçiyor
kriter arama olarak kodları 1.8.1* şeklinde dizayn edersek diğer "*" olan 1.8.1bütün verileri elemiş oluruz diye düşünüyorum ne dersiniz
 

Ekli dosyalar

numan şamil' Alıntı:
Hocam dediğniz gibi ekli dosyada Sayfa2 'yi doldurdum
Oradada görüleceği gibi 1.8 'li olanlarda Hepsinde
1.8.1* sonunda "*" olan verileri alması gerekiyor
Onun için kodlarda aranan kısmına
"*" eklemiştim
"*" olmayan veriyi almayacak

Bir tek istisna olan
C.70.1(37119406) olan veriyi almam gerekiyor
Birde
S-1.8.1* Başında S- olan veriler alınmayacak
36. mesajınızdaki dosyanızı inceledim bir şey hariç güzel çalışıyor
oda örneğin
1.8.1 satırını (sonunda"*" olmayan ) sildiğimdeki bu veriyi zaten almaması gerekiyor
hemen onun altında asıl alması gereken
1.8.1* veriyi boş geçiyor
kriter arama olarak kodları 1.8.1* şeklinde dizayn edersek diğer "*" olan 1.8.1bütün verileri elemiş oluruz diye düşünüyorum ne dersiniz
Genişletmek için tıkla ...

Birde bu dosyaya bak
 

Ekli dosyalar

halit3' Alıntı:
Birde bu kodu dene bakalım.

Kod: 
Option Explicit
Dim Klasor As Object
Dim Kaynak As String
Dim sut1 As String
Private Sub CommandButton1_Click()
Range("A:V").ClearContents
Range("A:V").NumberFormat = "@"
sut1 = 2
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.Items.Item.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Application.ScreenUpdating = False
Liste (Kaynak)
MsgBox "işlem tamam"
Application.DisplayAlerts = True
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Klasor = Nothing
End Sub
Private Sub Liste(Yol As String)
Dim aranan(8)
Dim deg1(500)
aranan(1) = "C.70.1": aranan(2) = "1.8.0*": aranan(3) = "1.8.1*":
aranan(4) = "1.8.2*": aranan(5) = "1.8.3*": aranan(6) = "5.8.0*":
aranan(7) = "8.8.0*": aranan(8) = "1.6.0*":
Dim a, t, y, i, r, j, yer, adres, aranan2, bulunan1, sut, deg, sat, sat2
Dim fL As Object, f As Object, Dosya As String
Set fL = CreateObject("Scripting.FileSystemObject").getfolder(Yol).SubFolders
Dosya = Dir(Yol & "\*.**")
Do While Dosya <> ""
DoEvents
If Right(Dosya, 4) = ".txt" Or Right(Dosya, 3) = ".tbr" Then
Cells(sut1, 1).Value = Dosya
sut = 0
Open (Yol & "/" & Dosya) For Input As #1
Do While Not EOF(1)
Line Input #1, deg
sut = sut + 1
If sut <= 20 Then
deg1(sut) = ""
deg1(sut) = deg
End If
Loop
Close

For i = 1 To 8
sat = 0
For r = 1 To 19
adres = deg1(r)
a = InStr(Trim(adres), aranan(i))
If a > 0 Then
sat = sat + 1
For j = a To Len(adres)
bulunan1 = InStr(j, adres, aranan(i), vbTextCompare)
If bulunan1 > 0 Then
aranan2 = WorksheetFunction.Trim(Mid(adres, bulunan1 + Len(aranan(i)), Len(adres)))
For t = 1 To Len(aranan2)
If Mid(aranan2, t, 1) = "(" Then sat2 = t: Exit For
Next t
yer = ""
For y = sat2 To Len(aranan2)
If Mid(aranan2, y, 1) = ")" Then Exit For
If IsNumeric((Mid(aranan2, y, 1))) = True Or (Mid(aranan2, y, 1)) = "." Then
yer = yer & (Mid(aranan2, y, 1))
End If
Next y
If yer <> "" Then
Cells(sut1, i + 2).Value = Replace((yer), ".", ",")
Else
Cells(sut1, i + 2).Value = ""
End If

End If
Exit For
Next j
If sat = 2 Then
Exit For
End If
End If
Next r
Next i
sut1 = sut1 + 1
End If
Dosya = Dir
Loop
On Error GoTo sonraki
For Each f In fL
Kaynak = f.Path
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
Genişletmek için tıkla ...

Hocam ekteki txt dosyasında
diğer firmaları sorunsuz alırken
f firmasına ait
C.70.1(37119411) değeri olan 37119411 almıyor
 

Ekli dosyalar

numan şamil' Alıntı:
Hocam ekteki txt dosyasında
diğer firmaları sorunsuz alırken
f firmasına ait
C.70.1(37119411) değeri olan 37119411 almıyor
Genişletmek için tıkla ...

If sut <= 20 Then

For r = 1 To 19

yukarıdaki kırmızı değerleri 25 yapıp deneyin
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst