Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 31-10-2017, 20:21   #1
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,754
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan html den excele ilgili hücreleri çekmek

Mail yoluyla gelen HTML ortamındaki ve aynı klasör içinde bulunan e-faturalardan excele ekte gönderdiğim şekilde ilgili hücrelerdeki dataları çekmek istiyorum.
Bu konuda bilgisi olan uzman arkadaşlarımdan yardım bekliyorum. Şimdiden teşekkürler.
Eklenmiş Dosyalar
Dosya Türü: rar html to excel.rar (71.0 KB, 13 Görüntülenme)
__________________
Kolay Gelsin Tahsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 08:57   #2
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 2,375
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Varsayılan

Uzman değilim ama yine de yardım edeyim dedim

VBA references de aşağıdakiler seçili olmalı.



Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Dim dosyahtml As String
Dim satir, kalemsatir As Long

Sub menu()
   Call temizle
   Call dosya_listesi
   Call son_duzenleme
End Sub

Sub son_duzenleme()
    Sheets("Liste").Select
    sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
    Range("J2:N" & sonsatir).Select
    Selection.NumberFormat = "#,##0.00"
    
    Columns("J:N").Select
    Selection.Replace What:="TL", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("J" & sonsatir).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
    Range("J" & sonsatir).Select
    Selection.AutoFill Destination:=Range("J" & sonsatir & ":N" & sonsatir), Type:=xlFillDefault
    Range("J2:N" & sonsatir - 1).Select
     
     For Each hucre In Selection
         hucre.Value = 0 + hucre.Value
     Next
    Range("J2").Select
    
    
    Sheets("FaturaKalem").Select
    sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
    Range("G2:H" & sonsatir).Select
    Selection.NumberFormat = "#,##0.00"
    Range("M2:M" & sonsatir).Select
    Selection.NumberFormat = "#,##0.00"
    
    Columns("G:M").Select
    Selection.Replace What:="TL", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("G:M").Select
    Selection.Replace What:=" TRY", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        
    Range("E" & sonsatir).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
    Range("H" & sonsatir).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
    Range("M" & sonsatir).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
    
    Range("G2:H" & sonsatir - 1, "M2:M" & sonsatir - 1).Select
     For Each hucre In Selection
         hucre.Value = 0 + hucre.Value
     Next
    Range("J2").Select
    
End Sub

Sub temizle()
        sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
        If sonsatir = 1 Then sonsatir = 2
        Range("A2:Q" & sonsatir).ClearContents
End Sub

Sub dosya_listesi()
    yol = ActiveWorkbook.Path
    filtre = yol & "\*.html"
    dosya = Dir(filtre)
    satir = 1
    While dosya <> ""
       dosyahtml = yol & "\" & dosya
       satir = satir + 1
       Call bilgi_al
       dosya = Dir
    Wend

    kalemsatir = 2
    sonsatir = Sheets("FaturaKalem").Cells(Rows.Count, "A").End(3).Row
    If sonsatir = 1 Then sonsatir = 2
    Sheets("FaturaKalem").Range("A2:Q" & sonsatir).ClearContents
        
    dosya = Dir(filtre)
    While dosya <> ""
       dosyahtml = yol & "\" & dosya
       Call kalem_al
       dosya = Dir
    Wend
End Sub

Sub kalem_al()
    Dim URL As String
    Dim IE As InternetExplorer
    Dim HTMLdoc As HTMLDocument
    Dim TDelements As IHTMLElementCollection
    Dim TDelement As HTMLTableCell
    Dim r As Long

    URL = dosyahtml
    Set IE = New InternetExplorer
    Set shkalem = Sheets("FaturaKalem")
    
    With IE
        .navigate URL
        .Visible = True
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
            Set HTMLdoc = .document
        End With
         
        Set TDelements = HTMLdoc.getElementsByTagName("TD")
         
        r = 0
        verial = False
        faturatarihial = False
        faturanoal = False
        For Each TDelement In TDelements
            gecici = Trim(TDelement.innerText)
            If gecici = "Fatura Tarihi :" And faturatarihial = False Then
               faturatarihial = True
               GoTo son
            End If
            If faturatarihial Then
              faturatarihi = gecici
              faturatarihial = False
            End If
            
            If gecici = "Fatura No:" And faturanoal = False Then
               faturanoal = True
               GoTo son
            End If
            
            If faturanoal Then
               faturanoal = False
               faturano = gecici
            End If
                
            If verial = False Then
                If InStr(gecici, "Net Tutar") > 0 Then
                   verial = True
                   GoTo son
                End If
            End If

                
            If verial Then
               If InStr(gecici, "Toplam Iskonto") > 0 Then GoTo bitti
               shkalem.Cells(kalemsatir, 1).Value = faturatarihi
               shkalem.Cells(kalemsatir, 2).Value = faturano
               
               r = r + 1
               shkalem.Cells(kalemsatir, r + 2).Value = TDelement.innerText
               If r Mod 11 = 0 Then
                 r = 0
                 kalemsatir = kalemsatir + 1
               End If
            End If
            'verial = False
son:
        Next
bitti:
     
    IE.Quit
    If shkalem.Cells(kalemsatir, 3) = "" Then
       shkalem.Cells(kalemsatir, 1).Clear
       shkalem.Cells(kalemsatir, 2).Clear
       
    End If
    
End Sub

Sub bilgi_al()
    Dim URL As String
    Dim IE As InternetExplorer
    Dim HTMLdoc As HTMLDocument
    Dim TDelements As IHTMLElementCollection
    Dim TDelement As HTMLTableCell
    Dim r As Long

    URL = dosyahtml
    Set IE = New InternetExplorer
    With IE
        .navigate URL
        .Visible = True
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
            Set HTMLdoc = .document
        End With
         
        Set TDelements = HTMLdoc.getElementsByTagName("TD")
         
        r = 0
        verial = False
        For Each TDelement In TDelements
            gecici = Trim(TDelement.innerText)
            If verial = False Then
                If gecici = "Fatura Saati:" Then verial = True
                If gecici = "Fatura Tarihi :" Then verial = True
                If gecici = "Sipariş Tarihi:" Then verial = True
                If gecici = "ERP Fatura No:" Then verial = True
                If gecici = "VKN / TCKN :" Then verial = True
                If gecici = "Toplam Iskonto" Then verial = True
                If gecici = "Net Toplam Tutar" Then verial = True
                If gecici = "KDV Matrahi (%18)" Then verial = True
                If gecici = "Genel Toplam" Then verial = True
                If gecici = "KDV Tutari (%18)" Then verial = True
                If gecici = "Fatura No:" Then verial = True
                If gecici = "Fatura No:" Then verial = True
                If gecici = "Vergi Dairesi:" Then verial = True
                If gecici = "Yaziyla Toplam Tutar" Then verial = True
                If gecici = "Tasima No:" Then verial = True
                GoTo son
            End If
            
            If verial Then
               r = r + 1
               Cells(satir, r).Value = TDelement.innerText
            End If
            verial = False
son:
        Next
    
    IE.Quit
    
End Sub
Eklenmiş Dosyalar
Dosya Türü: xlsm faturadata.xlsm (32.5 KB, 4 Görüntülenme)
__________________
www.asriakdeniz.com

Bu mesaj en son " 09-11-2017 " tarihinde saat 11:36 itibariyle asri tarafından düzenlenmiştir....
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 09:21   #3
kuvari
Destek Ekibi
 
kuvari kullanıcısının avatarı
 
Giriş: 04/05/2007
Şehir: İstanbul
Mesaj: 2,633
Excel Vers. ve Dili:
OFİS 2013 TÜRKÇE-İNG. 64 BİT
Varsayılan

Sayın asri merhaba,

Verdiğiniz kodun çalışması için sanırım referansların tools'tan açık olması gerekiyor.
Açık olması gereken referansları'da yazabilir misiniz.

İyi çalışmalar
__________________
Bilgi kadar zenginlik, cehalet kadar yoksulluk yoktur.
(Hz. Ali)
kuvari Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 09:25   #4
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 2,375
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Varsayılan

Alıntı:
kuvari tarafından gönderildi Mesajı Görüntüle
Sayın asri merhaba,

Verdiğiniz kodun çalışması için sanırım referansların tools'tan açık olması gerekiyor.
Açık olması gereken referansları'da yazabilir misiniz.

İyi çalışmalar
Uyarı için teşekkür ederim.
Bu konuyu hep atlıyorum
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 12:29   #5
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,754
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan

Sn. asri, ilginiz için çok teşekkür ederim, ancak ben bir türlü başaramadım, dediğiniz referansların hepsini işaretledim, dosyayı html dosyalarının bulunduğu klasör içine kayıt ettim, makrolarınızı modüle yapıtırıp çalıştırdığımda saadece internet explorer açılıyor, öylece kalıyor, eksik yaptığım birşeyler mi var, sonuç alamadım.
__________________
Kolay Gelsin Tahsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 13:08   #6
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 2,375
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Varsayılan

Alıntı:
tahsinanarat tarafından gönderildi Mesajı Görüntüle
Sn. asri, ilginiz için çok teşekkür ederim, ancak ben bir türlü başaramadım, dediğiniz referansların hepsini işaretledim, dosyayı html dosyalarının bulunduğu klasör içine kayıt ettim, makrolarınızı modüle yapıtırıp çalıştırdığımda saadece internet explorer açılıyor, öylece kalıyor, eksik yaptığım birşeyler mi var, sonuç alamadım.
Mesaja dosya eklendi. Buna dosyaya rağmen hala hata veriyor ise, tüm dosyaları c:\faturahtml nin altına kopyalayıp deneyin.
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 14:33   #7
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,754
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan

Sn. asri kardeşim şimdi deneme fırsatım oldu, elinize sağlık çok mükemmel çalışıyor, Allah sizden razı olsun, çok teşekkür ediyorum.
__________________
Kolay Gelsin Tahsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 15:40   #8
assenucler
Altın Üye
 
Giriş: 19/08/2004
Şehir: Istanbul
Mesaj: 2,502
Excel Vers. ve Dili:
Office 2016 TR - Windows 10 TR x64
Varsayılan

Üstadım,


Bendeki işletim sistemi Windows 10 TR 64X, böyle olunca açılan pencerede

Location: C:/Windows/SysWOW64.mshtml gözüküyor ve

C:faturahtml klasörü içindeki html'leri excel'e alamıyorum.

Nedeni ne olabilir?
__________________
Windows 10 Türkçe
Office 365 TR Ev Ekstra 2016
assenucler Çevrimdışı   Alıntı Yaparak Cevapla
Eski 01-11-2017, 15:45   #9
1903emre34@gmail.com
Altın Üye
 
Giriş: 29/05/2016
Şehir: İstanbul
Mesaj: 463
Excel Vers. ve Dili:
Microsoft Excel 2013 Türkçe
Varsayılan

Alıntı:
asri tarafından gönderildi Mesajı Görüntüle
Mesaja dosya eklendi. Buna dosyaya rağmen hala hata veriyor ise, tüm dosyaları c:\faturahtml nin altına kopyalayıp deneyin.
Merhaba,

Hata vermesine rağmen, c:\faturahtml nin altına ekledim aynı hatayı verdi.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
1903emre34@gmail.com Çevrimiçi   Alıntı Yaparak Cevapla
Eski 01-11-2017, 16:02   #10
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,754
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan

Sn.assenucler bendeki işletim sistemi de aynı, çok güzel çalışıyor, html dosya içeriği farklı olabilir, kodu inceleyerek almak istediğiniz dataları

If gecici = "Fatura Saati:" Then verial = True
If gecici = "Fatura Tarihi :" Then verial = True
If gecici = "Sipariş Tarihi:" Then verial = True

kontrol ederek denemenizi tavsiye ederim.
__________________
Kolay Gelsin Tahsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 14:48


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden