Txt veri aktarma Hk.

[talebeyim]

Halit bey, yukarıda ado ile bir soru sormustum ve anlamadığınızı belirtmiştim, konuyu daha sadeleştirmeye çalıştım. umarım yardımcı olabilirsiniz.

Teşekkür ederim.

 

[talebeyim]

Ek sorun

Halit agabey, Hayırlı ramazanlar dilerim. surada bir yerde takıldım, denemeler yapmama rağmen düzeltemedim...
Şu sihirli değneğini bi değdirde ne olacaksa olsun yahu

Agabey, Kodlar aşağıda, Veri aldığım Excel ve olmasını istediğim txt ekteki gibidir.

Ayrıca excelden txtye aktardığım dosyada birşeye dikkat çekmek istiyorum, tarih olan s ile başlayan satırlarda dolu boş boş bboş dolu gibi şeyler geçiyor.

örneğin 4tane boş bir dolu hücre varsa onu en başa getirmeli.

Bu kodu bir çalıştırırsan buna yakın birşeyler yapmaya calıstım. ama işte sıkıntılar var.

Sub txt()
Dim Dosya, Veri
Dosya = ThisWorkbook.Path & "\yazi.txt"
Open Dosya For Output As #1
For i = 1 To Cells(Rows.Count, "H").End(3).Row

If i = 2 Then
deg1 = LeftPadChar(Format(Cells(i, "B").Value, "##,##"), " ", 6) & "        M:"
deg2 = LeftPadChar(Format(Cells(i, "C").Value, "##,##"), " ", 6) & "        M:"
deg3 = LeftPadChar(Format(Cells(i, "D").Value, "##,##"), " ", 6) & "        M:"
deg4 = LeftPadChar(Format(Cells(i, "E").Value, "##,##"), " ", 6) & "        M:"
deg5 = LeftPadChar(Format(Cells(i, "F").Value, "##,##"), " ", 6) & "        M:"
deg6 = LeftPadChar(Format(Cells(i, "G").Value, "##,##"), " ", 6) & "        M:"
deg7 = LeftPadChar(Format(Cells(i, "H").Value, "##,##"), " ", 6) & "        M:"

ElseIf i = 3 Then
deg1 = deg1 & LeftPadChar(Format(Cells(i, "B").Value, "##,##"), " ", 7) & "       İ : "
deg2 = deg2 & LeftPadChar(Format(Cells(i, "C").Value, "##,##"), " ", 7) & "       İ : "
deg3 = deg3 & LeftPadChar(Format(Cells(i, "D").Value, "##,##"), " ", 7) & "       İ : "
deg4 = deg4 & LeftPadChar(Format(Cells(i, "E").Value, "##,##"), " ", 7) & "       İ : "
deg5 = deg5 & LeftPadChar(Format(Cells(i, "F").Value, "##,##"), " ", 7) & "       İ : "
deg6 = deg6 & LeftPadChar(Format(Cells(i, "G").Value, "##,##"), " ", 7) & "       İ : "
deg7 = deg7 & LeftPadChar(Format(Cells(i, "H").Value, "##,##"), " ", 7) & "       İ : "

ElseIf i = 4 Then
deg1 = deg1 & LeftPadChar(Format(Cells(i, "B").Value, "##,##"), " ", 8) & "     S :"
deg2 = deg2 & LeftPadChar(Format(Cells(i, "C").Value, "##,##"), " ", 8) & "     S :"
deg3 = deg3 & LeftPadChar(Format(Cells(i, "D").Value, "##,##"), " ", 8) & "     S :"
deg4 = deg4 & LeftPadChar(Format(Cells(i, "E").Value, "##,##"), " ", 8) & "     S :"
deg5 = deg5 & LeftPadChar(Format(Cells(i, "F").Value, "##,##"), " ", 8) & "     S :"
deg6 = deg6 & LeftPadChar(Format(Cells(i, "G").Value, "##,##"), " ", 8) & "     S :"
deg7 = deg7 & LeftPadChar(Format(Cells(i, "H").Value, "##,##"), " ", 8) & "     S :"
Else

If Cells(i, "B").Value <> "" Then
deg1 = deg1 & LeftPadChar(Cells(i, "B").Value, " ", 9) & "POP "
End If
If Cells(i, "C").Value <> "" Then
deg2 = deg2 & LeftPadChar(Cells(i, "C").Value, " ", 9) & "POP "
End If
If Cells(i, "D").Value <> "" Then
deg3 = deg3 & LeftPadChar(Cells(i, "D").Value, " ", 9) & "POP "
End If
If Cells(i, "E").Value <> "" Then
deg4 = deg4 & LeftPadChar(Cells(i, "E").Value, " ", 9) & "POP "
End If
If Cells(i, "F").Value <> "" Then
deg5 = deg5 & LeftPadChar(Cells(i, "F").Value, " ", 9) & "POP "
End If
If Cells(i, "G").Value <> "" Then
deg6 = deg6 & LeftPadChar(Cells(i, "G").Value, " ", 9) & "POP "
End If
If Cells(i, "H").Value <> "" Then
deg7 = deg7 & LeftPadChar(Cells(i, "H").Value, " ", 9) & "POP "
End If
End If


Next
Print #1, "4i     : " & deg1
Print #1,
Print #1, "6i     : " & deg2
Print #1,
Print #1, "Bi     : " & deg3
Print #1,
Print #1, "Ki     : " & deg4
Print #1,
Print #1, "Si     : " & deg5
Print #1,
Print #1, "Ti     : " & deg6
Print #1,
Print #1, "Ai     : " & deg7
Print #1,
Print #1,
Print #1, "N."
Print #1,
Print #1, "D."
Print #1,
Print #1,
Print #1, "B."
Print #1, "MN"
Print #1, "ÜA"
Print #1,
Close #1

Sheets("tablo").Select

End Sub

Function RightPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = Astr + String(stLen - AStrL, PadChar)
Else
Astr = Mid$(Astr, 1, stLen)
End If
RightPadChar = Astr
End Function

Function LeftPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = String(stLen - AStrL, PadChar) + Astr
Else
Astr = Mid$(Astr, 1, stLen)
End If
LeftPadChar = Astr
End Function

 

[halit3]

Son olarak kodları güncelliyorum.

Sub txt()
Dim Dosya, Veri
Dim deg(10)
 
Dosya = ThisWorkbook.Path & "\yazi.txt"
Open Dosya For Output As #1
For i = 1 To Cells(Rows.Count, "H").End(3).Row
If i = 1 Then
ElseIf i = 2 Then
deg(1) = RightPadChar(Format(Cells(i, "B").Value, "##,##"), " ", 3) & "M:"
deg(2) = RightPadChar(Format(Cells(i, "C").Value, "##,##"), " ", 3) & "M:"
deg(3) = RightPadChar(Format(Cells(i, "D").Value, "##,##"), " ", 3) & "M:"
deg(4) = RightPadChar(Format(Cells(i, "E").Value, "##,##"), " ", 3) & "M:"
deg(5) = RightPadChar(Format(Cells(i, "F").Value, "##,##"), " ", 3) & "M:"
deg(6) = RightPadChar(Format(Cells(i, "G").Value, "##,##"), " ", 3) & "M:"
deg(7) = RightPadChar(Format(Cells(i, "H").Value, "##,##"), " ", 3) & "M:"
ElseIf i = 3 Then
deg(1) = deg(1) & RightPadChar(Format(Cells(i, "B").Value, "##,##"), " ", 2) & "İ:"
deg(2) = deg(2) & RightPadChar(Format(Cells(i, "C").Value, "##,##"), " ", 2) & "İ:"
deg(3) = deg(3) & RightPadChar(Format(Cells(i, "D").Value, "##,##"), " ", 2) & "İ:"
deg(4) = deg(4) & RightPadChar(Format(Cells(i, "E").Value, "##,##"), " ", 2) & "İ:"
deg(5) = deg(5) & RightPadChar(Format(Cells(i, "F").Value, "##,##"), " ", 2) & "İ:"
deg(6) = deg(6) & RightPadChar(Format(Cells(i, "G").Value, "##,##"), " ", 2) & "İ:"
deg(7) = deg(7) & RightPadChar(Format(Cells(i, "H").Value, "##,##"), " ", 2) & "İ:"
ElseIf i = 4 Then
deg(1) = deg(1) & RightPadChar(Format(Cells(i, "B").Value, "##,##"), " ", 3) & Cells(6, "a").Value & ": "
deg(2) = deg(2) & RightPadChar(Format(Cells(i, "C").Value, "##,##"), " ", 3) & Cells(7, "a").Value & ": "
deg(3) = deg(3) & RightPadChar(Format(Cells(i, "D").Value, "##,##"), " ", 3) & Cells(8, "a").Value & ": "
deg(4) = deg(4) & RightPadChar(Format(Cells(i, "E").Value, "##,##"), " ", 3) & Cells(9, "a").Value & ": "
deg(5) = deg(5) & RightPadChar(Format(Cells(i, "F").Value, "##,##"), " ", 3) & Cells(10, "a").Value & ": "
deg(6) = deg(6) & RightPadChar(Format(Cells(i, "G").Value, "##,##"), " ", 3) & Cells(11, "a").Value & ": "
deg(7) = deg(7) & RightPadChar(Format(Cells(i, "H").Value, "##,##"), " ", 3) & Cells(12, "a").Value & ": "
ElseIf i = 5 Then
 
Else
 
k = k + 1
For j = 2 To 8
If Cells(i, j).Value <> "" Then
deg(k) = deg(k) & RightPadChar(Cells(i, j).Value, " ", 9) & "POP "
End If
Next
End If
Next
 
Print #1, "4i:" & deg(1)
Print #1,
Print #1, "6i:" & deg(2)
Print #1,
Print #1, "Bi:" & deg(3)
Print #1,
Print #1, "Ki:" & deg(4)
Print #1,
Print #1, "Si:" & deg(5)
Print #1,
Print #1, "Ti:" & deg(6)
Print #1,
Print #1, "Ai:" & deg(7)
Print #1,
Print #1,
Print #1, "N."
Print #1,
Print #1, "D."
Print #1,
Print #1,
Print #1, "B."
Print #1, "MN"
Print #1, "ÜA"
Print #1,
Close #1
'Sheets("tablo").Select
End Sub
Function RightPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = Astr + String(stLen - AStrL, PadChar)
Else
Astr = Mid$(Astr, 1, stLen)
End If
RightPadChar = Astr
End Function
Function LeftPadChar(ByVal Astr As String, PadChar As String, stLen As Integer) As String
Dim AStrL As Integer
Astr = Trim(Astr)
AStrL = Len(Astr)
If AStrL < stLen Then
Astr = String(stLen - AStrL, PadChar) + Astr
Else
Astr = Mid$(Astr, 1, stLen)
End If
LeftPadChar = Astr
End Function

 

[talebeyim]

Son olarak kodları güncelliyorum.

Sağolun