text oluşturma

[irfem4]

Kolay gelsin ustadlarım. ekte yüklediğin dosyada 5510_TXT sayfasındaki verilerin, GSS sayfasındaki "V" sutunu dönem verilerine göre ekteki text dosyası örneğine göre ayrı ayrı text olusturmak istiyorum. yardımlarınız için teşekkür ederim.

 

[Zeki Gürsoy]

Merhaba;

Aşağıdaki görselde belirttiğim gibi,
- "MEHMET ALİ DEMİR" listede iki defa geçtiği halde tekil olarak hangisi alınacak?
- "MEHMET ECER" listeye neden dahil değil?
- Kırmızı daire içine aldığım kısım, standart mı? Yoksa bir anlamı var mı?

Bunları netleştirirseniz tek seferde konu çözüme kavuşur.

 

[irfem4]

Merhaba;

Aşağıdaki görselde belirttiğim gibi,
- "MEHMET ALİ DEMİR" listede iki defa geçtiği halde tekil olarak hangisi alınacak?
- "MEHMET ECER" listeye neden dahil değil?
- Kırmızı daire içine aldığım kısım, standart mı? Yoksa bir anlamı var mı?

Bunları netleştirirseniz tek seferde konu çözüme kavuşur.

Ekli dosyayı görüntüle 251330

ilk soru: mehmet ali demir mart/2024 ve Nisan/2024 dönemlerine ait verileri olduğu için kişinin mart verisi Mart TXT dosyasında Nisan verisi Nisan TXT dosyasına aktarılacak.
ikinci soru: yukarıdaki açıklamadan dolayı örnek TXT mart/2024 için Mehmet Ecer Nisan/2024 TXT dosyasında olcak
üçüncü soru: işaretlediğiniz yer standart

 

[Zeki Gürsoy]

Boş bir module ekleyip kodu çalıştırın. Text dosyaları masaüstüne kaydedilecek.

Option Explicit

Sub CreateTxt()
    Dim gss As Worksheet, txt5510 As Worksheet, cn As Object, rs As Object
    Dim lastRow As Long, l As Long, strArr(22) As String, i As Integer, curDonem As String, iFile As Integer
    
    If Worksheets("GSS").[b7] = "" Then
        MsgBox "GSS listesi boş!", vbExclamation
        Exit Sub
    End If
    
    Set gss = Worksheets("GSS")
    Set txt5510 = Worksheets("5510_TXT")
    
    lastRow = IIf(gss.[b26] <> "", 26, gss.[b26].End(3).Row)
    
    For l = 7 To lastRow
        txt5510.Cells(l - 2, "x") = gss.Cells(l, "v")
        txt5510.Cells(l - 2, "y") = l - 6
    Next
    
    Set cn = CreateObject("Adodb.Connection")
    Set rs = CreateObject("Adodb.Recordset")
    
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
    
    rs.Open "select * from [" & Sayfa2.Name & "$A4:Y" & lastRow & "] where [Adı] <> '' order by 24, 25", cn, 1, 1
    
    lastRow = rs.RecordCount
    
    For l = 1 To lastRow
        If curDonem <> rs(23) Then
            curDonem = rs(23)
            
            If iFile <> 0 Then
                Print #iFile, "/" & vbCrLf & "0;0;0;0" & vbCrLf & "/"
                Close #iFile
            End If
            
            iFile = FreeFile
            
            Open Environ$("userprofile") & "Desktop\" & Replace(rs(23), "/", "_") & ".txt" For Output As #iFile
            
        End If

        For i = 0 To 22
        
            Select Case i
                Case 14 To 22
                    strArr(i) = Replace(rs(i), ",", ".", 1, 1)
                Case Else
                    strArr(i) = IIf(IsNull(rs(i)), "", rs(i))
            End Select
            
        Next

        Print #iFile, Join(strArr, ";")

        rs.movenext
    Next
    
    Print #iFile, "/" & vbCrLf & "0;0;0;0" & vbCrLf & "/"
    Close
    
    txt5510.Range("x5:y26").ClearContents
    
    rs.Close
    cn.Close
    
    Set rs = Nothing
    Set cn = Nothing
End Sub