Skip to main content
Rollback to Revision 2
Source Link
syb0rg
  • 21.8k
  • 10
  • 112
  • 191

Here I've made a little bit change

I've tried to modified the name into English (I hope it's clear enough for you?), and add some functions to reduce the complicity of the whole Sub.

PrivatePublic Sub WriteNameInserer_Nom_Fich(Optional ByVal file As String)
 
ActiveCell.Value = filenom_de_Fich
ActiveCell.Offset(0, 1).Select
 
End Sub
PrivatePublic Sub ImportFileInserer_contenu(Optional ByVal file As String)

Dim Onefile As Long
Open file For Input As #1

    Dim keyWord As String
     
keyWord = "Zone"
    WriteName file
    
    Dim Content As StringInserer_Nom_Fich
    Do While Not EOF(12)
        Line Input #1#2, Contentcontenu
        'if it's not a new zone:
        If InStr(Contentcontenu, keyWord) < 1 Then
            ActiveCell = Contentcontenu
    'if it's not:
  'if it's aElse new zone
        Else
           'goto next row  <<===========Here's the problem
     
        ActiveCell.Offset(1, 0).Select
            ActiveCell.End(xlToLeft).Select
            WriteNameInserer_Nom_Fich
            ActiveCell = Contentcontenu
        End If
        ActiveCell.Offset(0, 1).Select
    Loop
   'remove the last cell and goto next row  <<=============Problem
    ActiveCell.Offset(0, -1).Select
    ActiveCell.ClearLoop
    ActiveCell.Offset(1, 0).Select
    ActiveCell.End(xlToLeft).Select

Close #1

End Sub

Here I've made a little bit change

I've tried to modified the name into English (I hope it's clear enough for you?), and add some functions to reduce the complicity of the whole Sub.

Private Sub WriteName(Optional ByVal file As String)
 
ActiveCell.Value = file
ActiveCell.Offset(0, 1).Select
 
End Sub
Private Sub ImportFile(Optional ByVal file As String)

Dim Onefile As Long
Open file For Input As #1

    Dim keyWord As String
    keyWord = "Zone"
    WriteName file
    
    Dim Content As String
    Do While Not EOF(1)
        Line Input #1, Content
        'if it's not a new zone
        If InStr(Content, keyWord) < 1 Then
            ActiveCell = Content
        'if it's a new zone
        Else
           'goto next row  <<===========Here's the problem
            ActiveCell.Offset(1, 0).Select
            ActiveCell.End(xlToLeft).Select
            WriteName
            ActiveCell = Content
        End If
        ActiveCell.Offset(0, 1).Select
    Loop
   'remove the last cell and goto next row  <<=============Problem
    ActiveCell.Offset(0, -1).Select
    ActiveCell.Clear
    ActiveCell.Offset(1, 0).Select
    ActiveCell.End(xlToLeft).Select

Close #1

End Sub
Public Sub Inserer_Nom_Fich()
ActiveCell.Value = nom_de_Fich
ActiveCell.Offset(0, 1).Select
End Sub
Public Sub Inserer_contenu()

Dim keyWord As String
 
keyWord = "Zone"
Inserer_Nom_Fich
Do While Not EOF(2)
    Line Input #2, contenu
    'if it's a new zone:
    If InStr(contenu, keyWord) < 1 Then
        ActiveCell = contenu
    'if it's not:
    Else                                
        ActiveCell.Offset(1, 0).Select
        ActiveCell.End(xlToLeft).Select
        Inserer_Nom_Fich
        ActiveCell = contenu
    End If

    ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
ActiveCell.End(xlToLeft).Select
End Sub
added 611 characters in body
Source Link

Here I've made a little bit change

I've tried to modified the name into English (I hope it's clear enough for you?), and add some functions to reduce the complicity of the whole Sub.

PublicPrivate Sub Inserer_Nom_FichWriteName(Optional ByVal file As String) 

ActiveCell.Value = nom_de_Fichfile
ActiveCell.Offset(0, 1).Select 

End Sub
PublicPrivate Sub Inserer_contenuImportFile(Optional ByVal file As String)

Dim Onefile As Long
Open file For Input As #1

    Dim keyWord As String
 
    keyWord = "Zone"
Inserer_Nom_Fich    WriteName file
    
    Dim Content As String
    Do While Not EOF(21)
        Line Input #2#1, contenuContent
        'if it's not a new zone:
        If InStr(contenuContent, keyWord) < 1 Then
            ActiveCell = contenuContent
    'if it's not:
  'if it's Elsea new zone
        Else
           'goto next row  <<===========Here's the problem
    
         ActiveCell.Offset(1, 0).Select
            ActiveCell.End(xlToLeft).Select
        Inserer_Nom_Fich    WriteName
            ActiveCell = contenuContent
        End If
 
        ActiveCell.Offset(0, 1).Select
    Loop
   'remove the last cell and goto next row  <<=============Problem
    ActiveCell.Offset(0, -1).Select
    ActiveCell.Clear
    ActiveCell.Offset(1, 0).Select
    ActiveCell.End(xlToLeft).Select

Close #1

End Sub
Public Sub Inserer_Nom_Fich()
ActiveCell.Value = nom_de_Fich
ActiveCell.Offset(0, 1).Select
End Sub
Public Sub Inserer_contenu()

Dim keyWord As String
 
keyWord = "Zone"
Inserer_Nom_Fich
Do While Not EOF(2)
    Line Input #2, contenu
    'if it's a new zone:
    If InStr(contenu, keyWord) < 1 Then
        ActiveCell = contenu
    'if it's not:
    Else                               
         ActiveCell.Offset(1, 0).Select
        ActiveCell.End(xlToLeft).Select
        Inserer_Nom_Fich
        ActiveCell = contenu
    End If
 
    ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
ActiveCell.End(xlToLeft).Select
End Sub

Here I've made a little bit change

I've tried to modified the name into English (I hope it's clear enough for you?), and add some functions to reduce the complicity of the whole Sub.

Private Sub WriteName(Optional ByVal file As String) 

ActiveCell.Value = file
ActiveCell.Offset(0, 1).Select 

End Sub
Private Sub ImportFile(Optional ByVal file As String)

Dim Onefile As Long
Open file For Input As #1

    Dim keyWord As String
    keyWord = "Zone"
    WriteName file
    
    Dim Content As String
    Do While Not EOF(1)
        Line Input #1, Content
        'if it's not a new zone
        If InStr(Content, keyWord) < 1 Then
            ActiveCell = Content
        'if it's a new zone
        Else
           'goto next row  <<===========Here's the problem
            ActiveCell.Offset(1, 0).Select
            ActiveCell.End(xlToLeft).Select
            WriteName
            ActiveCell = Content
        End If
        ActiveCell.Offset(0, 1).Select
    Loop
   'remove the last cell and goto next row  <<=============Problem
    ActiveCell.Offset(0, -1).Select
    ActiveCell.Clear
    ActiveCell.Offset(1, 0).Select
    ActiveCell.End(xlToLeft).Select

Close #1

End Sub
deleted 21 characters in body; edited title
Source Link
Jamal
  • 34.9k
  • 13
  • 133
  • 237

VBA_Accelerate Accelerate the process of Fillingfilling the quelityquality control table

I'm working on a report of quality control. I've got a table, with all the points of control inside, and each time, when I get a new test result, EXCELExcel should fill this table. My code already works, but slowly (I have 15000 lines in this table, and it takes me 4 minutes to fill it), so I wish I can accelerate a little bit. Here is my general idea:

Here is my general idea:

The results of one test is composted by nearly 3000 txt.txt files, and I have a list L which contains the names of all these files that I should open and import the data into EXCELExcel. I open the list L, and open the txt.txt file one by one, to import the reslutsresults into a sheet "Brouillon" all at once, then fill the table with its help. I think it could be faster. Here is my code:

__

thenThen I'll do the nearly the same thing to put all these haven't been opened files at the end of the table. Because they are the new tests points that have been just added into the test, so there is no correct 'place' for them, and I have to complete and improve the table.

_

_

So this is the code, it'sIt's a little bit too long, so I've tried to add some comments to help you to read. If you've got some ideas to improve and acelerateaccelerate the program, or something i'veI've not good exlplainedexplained, please leave a comment. Thanks!

VBA_Accelerate the process of Filling the quelity control table

I'm working on a report of quality control. I've got a table, with all the points of control inside, and each time, when I get a new test result, EXCEL should fill this table. My code already works, but slowly (I have 15000 lines in this table, and it takes me 4 minutes to fill it), so I wish I can accelerate a little bit. Here is my general idea:

The results of one test is composted by nearly 3000 txt. files, and I have a list L which contains the names of all these files that I should open and import the data into EXCEL. I open the list L, and open the txt. file one by one, to import the resluts into a sheet "Brouillon" all at once, then fill the table with its help. I think it could be faster. Here is my code:

__

then I'll do the nearly the same thing to put all these haven't been opened files at the end of the table. Because they are the new tests points that have been just added into the test, so there is no correct 'place' for them, and I have to complete and improve the table.

_

_

So this is the code, it's a little bit too long, so I've tried to add some comments to help you to read. If you've got some ideas to improve and acelerate the program, or something i've not good exlplained, please leave a comment. Thanks!

Accelerate the process of filling the quality control table

I'm working on a report of quality control. I've got a table, with all the points of control inside, and each time, when I get a new test result, Excel should fill this table. My code already works, but slowly (I have 15000 lines in this table, and it takes me 4 minutes to fill it), so I wish I can accelerate a little bit.

Here is my general idea:

The results of one test is composted by nearly 3000 .txt files, and I have a list L which contains the names of all these files that I should open and import the data into Excel. I open the list L, and open the .txt file one by one, to import the results into a sheet "Brouillon" all at once, then fill the table with its help. I think it could be faster.

Then I'll do the nearly the same thing to put all these haven't been opened files at the end of the table. Because they are the new tests points that have been just added into the test, there is no correct 'place' for them, and I have to complete and improve the table.

It's a little bit too long, so I've tried to add some comments to help you to read. If you've got some ideas to improve and accelerate the program, or something I've not good explained, please leave a comment.

Source Link
Loading