ba-bs formu için

[alldemo]

arkadaşlar ba-bs formu için yardım edermisiniz. konu sayfa 1 de faturalar mevcut YAPMAK İSTEDİGİMİZ SAYFA 2 YE AYNI İSİM VE ÜNVANDA OLANLARI MAL HİZMET BEDELİ NE GÖRE KAÇ TANE FATURASI VARSA HEM MİKTAR VE HEM SAYI OLARAK TOPLAYARAK TÜM BİLGİLERİ SAYFA 2 YE AKTARMASI VE SAYFA 2 DENDE BİR TUŞ VEYA KOMUTLA XML DOSYASINA ÇEVİRMESİ örnek dosya ektedir yardımcı olacak arkadaşlar için şimdiden teşekürler.

 

[halit3]

arkadaşlar ba-bs formu için yardım edermisiniz. konu sayfa 1 de faturalar mevcut YAPMAK İSTEDİGİMİZ SAYFA 2 YE AYNI İSİM VE ÜNVANDA OLANLARI MAL HİZMET BEDELİ NE GÖRE KAÇ TANE FATURASI VARSA HEM MİKTAR VE HEM SAYI OLARAK TOPLAYARAK TÜM BİLGİLERİ SAYFA 2 YE AKTARMASI VE SAYFA 2 DENDE BİR TUŞ VEYA KOMUTLA XML DOSYASINA ÇEVİRMESİ örnek dosya ektedir yardımcı olacak arkadaşlar için şimdiden teşekürler.

Ekli dosyayı irdeleyin'

kodlar:

Sub aktar()
Worksheets("Sayfa2").Range("A1:G" & Rows.Count).ClearContents
For n = 1 To 7
Sheets("Sayfa2").Cells(1, n).Value = Sheets("Sayfa1").Cells(1, n).Value
Next n
sat = WorksheetFunction.CountA(Worksheets("Sayfa2").Range("A2:A" & Rows.Count)) + 2
For r = 2 To Worksheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(r, "B").Value
say6 = 0
say7 = 0
If Sheets("Sayfa1").Cells(r, "B").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("B2:B" & r), aranan1) = 1 Then
For i = r To Worksheets("Sayfa1").Cells(Rows.Count, "B").End(3).Row
aranan2 = Sheets("Sayfa1").Cells(i, "B").Value
If aranan2 = aranan1 Then
say6 = say6 + CDbl(Sheets("Sayfa1").Cells(i, 6).Value)
say7 = say7 + CDbl(Sheets("Sayfa1").Cells(i, 7).Value)
End If
Next i
Sheets("Sayfa2").Cells(sat, 1).Value = Sheets("Sayfa1").Cells(r, 1).Value
Sheets("Sayfa2").Cells(sat, 2).Value = Sheets("Sayfa1").Cells(r, 2).Value
Sheets("Sayfa2").Cells(sat, 3).Value = Sheets("Sayfa1").Cells(r, 3).Value
Sheets("Sayfa2").Cells(sat, 4).Value = Sheets("Sayfa1").Cells(r, 4).Value
Sheets("Sayfa2").Cells(sat, 5).Value = Sheets("Sayfa1").Cells(r, 5).Value
Sheets("Sayfa2").Cells(sat, 6).Value = say6
Sheets("Sayfa2").Cells(sat, 7).Value = say7
sat = sat + 1
End If
End If
Next r
MsgBox " Düzenleme Tamanlanmıştır..."
End Sub

Sub dosyayıkayıtet()
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
 
uzanti = ".xml" 
dosya_adi = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - InStr(1, StrReverse(ActiveWorkbook.Name), ".", vbTextCompare))
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
TempFilePath = ThisWorkbook.Path & "\" 'Application.DefaultFilePath & "\"
TempFileName = "Kayıt " & dosya_adi & " " & Format(Now, "dd-mmm-yyyy hh-mm-ss")
ActiveSheet.DrawingObjects.Delete
With Destwb
.SaveAs TempFilePath & TempFileName & uzanti, FileFormat:=xlXMLSpreadsheet '52
.Close SaveChanges:=False
End With
MsgBox "Kayıt yapıldığı yer" & Chr(10) & ThisWorkbook.Path & Chr(10) & TempFileName  'Application.DefaultFilePath
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[alldemo]

herşey için çok teşekürler bu işimi fazlasıyla görür elinize sağlık. fakat sayfa 2 den bu verileri xml dosya formatına çevirmek istiyorurdum onu olmamış. vergi dairesi xml dosya formatı ile istiyor. örnek e sgk e bildirgede var ecxel verilerini bir buton xml ye gönüştürüyor. yardım için tekrar teşekür ederim

 

[alldemo]

özür dilerim dosya zaten xml dosyaı olmuş yanlış görmüşüm teşekürler