Çözüldü Userform ile excele çoklu aktarım

bu durumda her blok "(" ve ")" arasında mı?
blokların içinde "(" yada ")" olabilir mi?
blokları bölmek için daha önceden dz = Split(metin, "FPL-") deki gibi "FPL-" kullanıyorduk eğer parantezler sadece başta ve sonda varsa bölmek için "FPL-" yerine "(" kullanılabilir.

halily' Alıntı:

bu durumda her blok "(" ve ")" arasında mı?
blokların içinde "(" yada ")" olabilir mi?
blokları bölmek için daha önceden dz = Split(metin, "FPL-") deki gibi "FPL-" kullanıyorduk eğer parantezler sadece başta ve sonda varsa bölmek için "FPL-" yerine "(" kullanılabilir.

Genişletmek için tıkla...

Evet her blok "(" ve ")" arasında. Metin başlangıcı için "(" ve sonu için ")" kullanılabilir.

Excel005' Alıntı:

Excele aktarılacak veriler: ABC123,ABC256,ABC368,ABC479,ABC689
Excele aktarılmayacak veriler:ABC585,ABC762

Genişletmek için tıkla...

demişsiniz ama

Excel005' Alıntı:

wx = InStr(1, metin, "-WXYZ"): If wx = 0 Then GoTo xAtla

Genişletmek için tıkla...

yukardaki kodda eğer ifadede "-WXYZ" yoksa atla diyor oysan ilk mesajdaki örnek veride "-WXYZ" yok dolayısıyla hiç bir veriyi almaması gerekiyor

halily' Alıntı:

demişsiniz ama

yukardaki kodda eğer ifadede "-WXYZ" yoksa atla diyor oysan ilk mesajdaki örnek veride "-WXYZ" yok dolayısıyla hiç bir veriyi almaması gerekiyor

Genişletmek için tıkla...

Örnek veri olduğu için o ihtimali atlamışım doğru söylüyorsunuz hiç birini almaz, asıl verilerimde ama -WXYZ olacak. Kodu işte deneyebiliyorum ,demeyince dönüş yaparım.

veyselemre' Alıntı:

Kod:

Değerli Misafirimiz İçeriği Görebilmek İçin Üyemiz İseniz Giriş Yap'ın Ya da Üye Ol'un.

Genişletmek için tıkla...

Teşekkürler, kodu işte deneyince dönüş yaparım. İyi günler

halily' Alıntı:

kodu aşağıdaki gibi düzenleyip dener misiniz?

Kod:

Değerli Misafirimiz İçeriği Görebilmek İçin Üyemiz İseniz Giriş Yap'ın Ya da Üye Ol'un.

Genişletmek için tıkla...

Merhaba, kodu yeni deneyebildim. Kod tek excel sayfası için çalışıyor ancak bir önceki kod tarihe göre, haftanın günleri için ayrı ayrı excel sayfalarına atıyordu. İkisini birleştirmeyi denedim ama farklı parametreler tanımlandığı için bunu başaramadım. Teşekkür ederim, iyi günler.

Madem ki haftanın günlerine gore aktarılacaktı o zaman neden günlere ayıran kodu değil de bu kodu kullandınız

halily' Alıntı:

Madem ki haftanın günlerine gore aktarılacaktı o zaman neden günlere ayıran kodu değil de bu kodu kullandınız

Genişletmek için tıkla...

Siz söyleyince farkettim. Hata benim eski kodu eklemişim, sizi boşuna meşgul ettiğim için özür diliyorum,kusura bakmayın. Hakkınızı helal edin.



-------------------günlere göre excele aktaran kod-----------------------------------



Private Sub CommandButton1_Click()
'On Error GoTo son
metin = Replace(Replace(" " & TextBox1.Text, Chr(10), " "), Chr(13), " ")

Dz = Split(metin, "FPL-")

xSay = UBound(Dz)
Dim dzS() As Variant: ReDim dzS(1 To xSay, 1)
Dim dzK_AB() As Variant

Dim xDz(1 To 7, 1) As Variant
Dim xSon(1 To 7, 1) As Variant
For xGun = 1 To 7
son = ThisWorkbook.Worksheets("sayfa" & xGun).Cells(Rows.Count, "A").End(3).Row
DzxL = ThisWorkbook.Worksheets("sayfa" & xGun).Range("A2:B" & son).Value
ReDim dzK_AB(1 To son + xSay - 1)
For x = 1 To son - 1
dzK_AB(x) = Trim(DzxL(x, 1)) & "|" & Trim(DzxL(x, 2))
Next x
xSon(xGun, 0) = 0
xSon(xGun, 1) = son + 1
xDz(xGun, 0) = dzK_AB
xDz(xGun, 1) = dzS
Next xGun

For x = 1 To xSay
metin = Dz(x)
s2 = InStr(metin, "-")
mA = Trim(Left(metin, s2 - 1))
xV = (Mid(metin, s2, 2) = "-V")
xIM = (Mid(metin, s2, 3) = "-IM")
If Not IsError(Application.Match(Left(mA, 3), Array("EEE", "DDD", "FFF", "GGG"), False)) Or xV Then GoTo xAtla
If Not IsError(Application.Match(Left(mA, 2), Array("HH"), False)) Or xIM Then GoTo xAtla

sTrh = InStr(1, metin, "DOF/")
mTrh = Trim(Mid(metin, sTrh + 4, 6))
mTrh = Right(mTrh, 2) & "." & Mid(mTrh, 3, 2) & "." & Left(mTrh, 2)
mTrh = Weekday(CDate(mTrh), 2)
dzK_AB = xDz(mTrh, 0)

wx = InStr(1, metin, "-WXYZ"): If wx = 0 Then GoTo xAtla
s1 = InStr(1, metin, "REG/"): If s1 = 0 Then GoTo xAtla
s2 = InStr(s1, metin, " ")
mB = Trim(Mid(metin, s1 + 4, s2 - s1 - 4))
If Not IsError(Application.Match(mA & "|" & mB, dzK_AB, False)) Then GoTo xAtla

xSon(mTrh, 0) = xSon(mTrh, 0) + 1
xY = xSon(mTrh, 0)
son = xSon(mTrh, 1)

xDz(mTrh, 1)(xY, 0) = mA
xDz(mTrh, 1)(xY, 1) = mB
dzK_AB(son + xY - 2) = mA & "|" & mB
xDz(mTrh, 0) = dzK_AB

xAtla:
Next x
Debug.Print

For xGun = 1 To 7
son = xSon(xGun, 1)
xY = xSon(xGun, 0)
dzS = xDz(xGun, 1)
If xY > 0 Then ThisWorkbook.Worksheets("sayfa" & xGun).Range("A" & son).Resize(xY, 2) = dzS
Next xGun

TextBox1.Text = Empty
'MsgBox "Bitti"
Exit Sub
son:
MsgBox "Kelimelerde olmayan değerler oluştu kontrol ediniz", vbCritical, "DİKKAT"
End Sub

Yeni konu açıp orada sormanız daha uygun olur
Uygun bir arkadaş yardımcı olacaktır ama kodları inceleyerek siz de yapabilirsiniz, hatırladığım kadarıyla çok fazla değişiklik olmadı.

halily' Alıntı:

Yeni konu açıp orada sormanız daha uygun olur
Uygun bir arkadaş yardımcı olacaktır ama kodları inceleyerek siz de yapabilirsiniz, hatırladığım kadarıyla çok fazla değişiklik olmadı.

Genişletmek için tıkla...

Yeni konu açıyorum. Teşekkür ederim.