Web sitesinden veri almak

[all_per]

Arkadaşlar ;

Yaklaşık 2 ay sonra GRE sınavına gireceğim ve bunun için son zamanlarımda kelime ezberleme işine yöneleceğim.

Şimdi elimde bir site var ve burada alfabetik olarak kelimeler anlamları , eş anlamlıları fln. ne ararsam var.

Ben buna bir makro yazmak istiyorum.

Ekteki tabloda birinci sayfada yer alan LİSTE tablosundaki birinci satıra ait verileri web sitesinden çektim ve A1 hüvresinden itibaren yapıştırdım.

Benim istediğim LİSTE tablosundaki her bir satırı teker teker çekip tüm listeyi alt alta versin. Onu da İSTENİLEN sayfasında gösterdim.

Yardımcı olabilirseniz çok sevinirim...

Şimdiden sağolun...

 

[mancubus]

aşağıdakini deneyin.

ben denediğimde 292 si de geldi.

Sub DENEME()

Dim sURL As String, wrd As String
Dim cll As Range

For Each cll In Worksheets("LİSTE").Range("A1:A" & Range("A65536").End(xlUp).Row)
    sURL = "URL;" & cll.Value
    wrd = Right(cll, 35)
    Worksheets("WEB SAYFASINDAN ALINAN").Activate
    With ActiveSheet.QueryTables.Add(Connection:=sURL, Destination:=Range("A65536").End(xlUp).Offset(1, 0))
        .Name = wrd
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "7"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    sURL = ""
    wrd = ""
Next

End Sub

 

[muhasiptör]

çalışmıyor bilader

 

[all_per]

Sayın mancubus ;

derdime derman olduğunuz için teşekkür ederim..ben denedim çalışıyor bir problem yok şu anda ama diğer harfler için de tek tek yapacağım.Bir sorunla karşılaşırsam size dönerim tekrar...

iyi çalışmalar...

 

[all_per]

Sayın mancubus ;

Aynı konu ile ilgili bir başka sorum olacak...

Ben aktardığım verileri düzenleyerek satır - sütun döngüsü oluşturmak istiyorum ama bunu kopyala yapıştıır metodu ile beceremedim.

Derdimi örnek dosyada aktardım. Buna uygun bir makro varmıdır acaba?

Teşekkür ederim...

 

[mancubus]

konu "excel'e yeni başlamak" için çok iddialı elbette.

aşağıdaki kodu deneyin.

Sub sat_kopyala()

Dim wks1 As Worksheet, wks2 As Worksheet
Dim aranacak As Range, bul As Range
Dim ilkadres As String, ara As String
Dim ssut As Long

Set wks1 = Worksheets("Veri")
Set wks2 = Worksheets("Satır - Sütun Dönüşümü")
Set aranacak = wks1.Range("A:A")
ara = "Word ID:"

If wks1.Cells(1, 1) <> "" Then wks1.Rows("1:1").EntireRow.Insert
With aranacak
    Set bul = .Find(ara, lookat:=xlPart)
    If Not bul Is Nothing Then
        ilkadres = bul.Address
        Do
            ssut = wks2.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
            If ssut < 256 Then
                bul.Offset(0, 1).Resize(8, 1).Copy Destination:=wks2.Cells(1, ssut)
            Else
                ssut = wks2.Cells(10, Columns.Count).End(xlToLeft).Offset(0, 1).Column
                bul.Offset(0, 1).Resize(8, 1).Copy Destination:=wks2.Cells(10, ssut)
            End If
            Set bul = .FindNext(bul)
        Loop While Not bul Is Nothing And bul.Address <> ilkadres
    End If
End With

End Sub

 

[all_per]

süper bir yardım teşekkür ederim ellerinize sağlık...

bana çok faydası oldu...tekrar teşekkürler...

 

[mancubus]

rica ederim.
ben de sayenizde bu siteyi öğrendim. teşekkür ederim.

 

[muhasiptör]

MANCUBUS arkadaşım banada yardım edermisin bir personelle ilgili çalışma var ama bu çalışmada depo ve depo hareketleri var bunları kaldırıp personel hareketlerini koyabilirmisin ben yapamıyorum