Jump to content
¯\_( ツ)_/¯
  • TAD GROUP are currently hiring penetration testers. Please read the topic in Career Central subforum.
  • Sponsored Ad
ТУК НЕ СЕ ПРЕДЛАГАТ ХАКЕРСКИ УСЛУГИ ! ×
Sign in to follow this  
georgijl

Visual basic (Excel)!

Recommended Posts

Здравейте имам следния проблем и не мога да го разреша, ако някой може да помогне ще съм много благодарен. Та проблемът е че получавам всеки ден .csv репорти и искам да ги автоматизирам сами да се копират и поставят в един sheet в екселски документ. Само че ми ги поставя хоризонтално от ляво на дясно а не от горе надолу ето и кодът:

Ако някой има някакви идеи да заповяда :) . Благодаря!

Public Sub Sample()
Dim Fl          As Object
Dim Fldr        As Object
Dim FSO         As Object
Dim LngColumn   As Long
Dim WkBk_Dest   As Excel.Workbook
Dim WkBk_Src    As Excel.Workbook
Dim WkSht_Dest  As Excel.Worksheet
Dim WkSht_Src   As Excel.Worksheet

'Using FileSystemObject to get the folder of files
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder("D:\Tables\")

'Setting a reference to the destination worksheet (i.e. where the
'data we are collecting is going to)
Set WkBk_Dest = ThisWorkbook
Set WkSht_Dest = WkBk_Dest.Worksheets("Merged")

'Look at each file in the folder
For Each Fl In Fldr.Files

    'Is it a xls, xlsx, xlsm, etc...
    If InStr(1, Right(Fl.Name, 5), ".csv") <> 0 Then

        'Get the next free column in our destination
        LngColumn = WkSht_Dest.Cells(1, WkSht_Dest.Columns.Count).End(xlToLeft).Column
        If LngColumn > 1 Then LngColumn = LngColumn + 1

        'Set a reference to the source (note in this case it is simply selected the first worksheet
        Set WkBk_Src = Application.Workbooks.Open(Fl.Path)
        Set WkSht_Src = WkBk_Src.Worksheets(1)

            'Copy the data from source to destination
            WkSht_Src.UsedRange.Copy WkSht_Dest.Cells(1, LngColumn)

        Set WkSht_Src = Nothing
        WkBk_Src.Close 0
        Set WkBk_Src = Nothing
    End If
Next

Set WkSht_Dest = Nothing

Set WkBk_Dest = Nothing
Set Fldr = Nothing
Set FSO = Nothing

End Sub
 

Share this post


Link to post
Share on other sites

Викаш тука стана и форум за програмиране и сортиране!

Share this post


Link to post
Share on other sites

Тоя VB много грозен. На мен ми се наложи нещо такова да правя и използвах https://openpyxl.readthedocs.io/en/stable/ python библиотека.

Ако си пренапишеш на python това което ти трябва и пак имаш проблем, сигурно ще може да ти се помогне. 

Share this post


Link to post
Share on other sites

Обърни специално внимание на следния код:

 

 WkSht_Src.UsedRange.Copy WkSht_Dest.Cells(1, LngColumn)

 

Машината прави това, което се иска от нея. :)

Ясно е указано, че клетките от една колона се прехвърлят в клетки от един ред.

Всяка клетка има номер на ред и номер на колона. Не може номерът на реда да е фиксиран. Той трябва да е променлива.

Това е често срещата логическа грешка.

 

 

 

 

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...

Important Information

By using this site, you agree to our Terms of Use. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.