Microsoft Excel

Herbers Excel/VBA-Archiv

automatisches Makro update??

Betrifft: automatisches Makro update?? von: Ansgar
Geschrieben am: 09.09.2004 08:59:12

Moin,

habe hier mal ein bisschen rumgesucht, aber die Antwort auf meine Frage nicht gefunden.
Kann mir jemand bei folgender Frage helfen?

Ich habe einen Makro in VBA in Excel geschrieben, der aus unterschiedlichen Worksheets Infos raussucht und eine Tabelle befuellt. Nun will ich sicherstellen, dass wann immer ein User die unterliegenden Infos aendert der Makro automatisch die Tabelle mit den neuen Werten updated (also ohne dass ein Button gepresst werden muss!).

Geht das?

Danke vorab
Ansgar

PS: Die unterliegende Info kommt aus unterschiedlichen Sheets und besteht aus bis zu 1000 Zellen, es ist also unmoeglich, z.B. alle Zellen individuell auf Aenderungen zu checken.

  


Betrifft: AW: automatisches Makro update?? von: Daniel
Geschrieben am: 09.09.2004 09:02:50

Hi,
ja, die Möglichkeit gibt es. Wenn irgendwo im gesamten Excel Dokument etwas geändert wird, und zwar über:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
...
End Sub


mfg Daniel


  


Betrifft: AW: automatisches Makro update?? von: Ansgar
Geschrieben am: 09.09.2004 09:48:53

Hi Daniel,

danke fuer die Antwort. Ich habe leider wirklich keine Ahnung von VBA und daher kann ich mit Deiner Antwort so noch nicht viel anfangen.

Wenn ich die neue
Sub generiere, laeuft die dann von alleine? 
Was ist ByVal?

Vielleicht hilft es, wenn ich mal den Makro hier rein kopiere?

Das ist mein Makro bisher (und es hat mich schon lange genug gedauert, dieses sehr unelegante Teil zusammenzufriemeln...)

Falls einer die Musse hat, mir noch ein bisschen weiterzuhelfen, waere das genial...

Vielen Dank vorab,
Ansgar

Dim row_label As Integer
Dim col_label As Integer
Dim reset_row_label As Integer
Dim ID As Integer
Dim current_sheet As String
Dim paste_row As Integer


Sub transpose_data()

'Deletes current values from the table

Worksheets("SubProject Summary").Select
    Rows("17:20000").Select
    Selection.ClearContents
    Range("a2").Select


paste_row = 17
ID = 1

'Start at Begin and move to first sheet in the series
Sheets("Begin").Select
ActiveSheet.Next.Select


Do While Not ActiveSheet.Name = "End"

'sets the activeworksheet to get data from
current_sheet = ActiveSheet.Name

'data constants to get from the active worksheet
subproject = ActiveSheet.Cells(9, 4)

     
'shows result worksheet so you can see data transfer
    Worksheets("SubProject Summary").Select
    
'sets the set of data to copy
    row_label = 57
    
'get the name of the SubProject
    Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
    
    Do While Not row_label = 58

    For col_label = 6 To 32
    
'get relevant data and paste into "SubProject Summary" sheet
    Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
    
    Next col_label

    row_label = 58

    Loop
   
'move to next paste row
   paste_row = paste_row + 1
   
'sets the next set of data to copy
    row_label = 63
    
'get the name of the SubProject
    Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
    
    Do While Not row_label = 64

    For col_label = 6 To 32
    
'get relevant data and paste into "SubProject Summary" sheet
    Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
    
    Next col_label

    row_label = 64

    Loop
   

'move to next paste row
   paste_row = paste_row + 1
   
'sets the next set of data to copy
    row_label = 68
    
'get the name of the SubProject
    Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
    
    Do While Not row_label = 69

    For col_label = 6 To 32
    
'get relevant data and paste into "SubProject Summary" sheet
    Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
    
    Next col_label

    row_label = 69

    Loop
   
        
'move to next paste row
   paste_row = paste_row + 1
   
'sets the next set of data to copy
    row_label = 74
    
'get the name of the SubProject
    Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
    
    Do While Not row_label = 75

    For col_label = 6 To 32
    
'get relevant data and paste into "SubProject Summary" sheet
    Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
    
    Next col_label

    row_label = 75

    Loop
        
'move to next paste row
   paste_row = paste_row + 1
        
        
    Worksheets(current_sheet).Select
    ActiveSheet.Next.Select

Loop

Worksheets("SubProject Summary").Select

End Sub



  


Betrifft: AW: automatisches Makro update?? von: Ansgar
Geschrieben am: 09.09.2004 09:54:56

Hi Daniel,

danke fuer die Antwort. Ich habe leider wirklich keine Ahnung von VBA und daher kann ich mit Deiner Antwort so noch nicht viel anfangen.

Wenn ich die neue
Sub generiere, laeuft die dann von alleine? 
Was ist ByVal?

Vielleicht hilft es, wenn ich mal den Makro hier rein kopiere?

Das ist mein Makro bisher (und es hat mich schon lange genug gedauert, dieses sehr unelegante Teil zusammenzufriemeln...)

Falls einer die Musse hat, mir noch ein bisschen weiterzuhelfen, waere das genial...

Vielen Dank vorab,
Ansgar

Dim row_label As Integer
Dim col_label As Integer
Dim reset_row_label As Integer
Dim ID As Integer
Dim current_sheet As String
Dim paste_row As Integer


Sub transpose_data()

'Deletes current values from the table

Worksheets("SubProject Summary").Select
    Rows("17:20000").Select
    Selection.ClearContents
    Range("a2").Select


paste_row = 17
ID = 1

'Start at Begin and move to first sheet in the series
Sheets("Begin").Select
ActiveSheet.Next.Select


Do While Not ActiveSheet.Name = "End"

'sets the activeworksheet to get data from
current_sheet = ActiveSheet.Name

'data constants to get from the active worksheet
subproject = ActiveSheet.Cells(9, 4)

     
'shows result worksheet so you can see data transfer
    Worksheets("SubProject Summary").Select
    
'sets the set of data to copy
    row_label = 57
    
'get the name of the SubProject
    Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
    
    Do While Not row_label = 58

    For col_label = 6 To 32
    
'get relevant data and paste into "SubProject Summary" sheet
    Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
    
    Next col_label

    row_label = 58

    Loop
   
'move to next paste row
   paste_row = paste_row + 1
   
'sets the next set of data to copy
    row_label = 63
    
'get the name of the SubProject
    Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
    
    Do While Not row_label = 64

    For col_label = 6 To 32
    
'get relevant data and paste into "SubProject Summary" sheet
    Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
    
    Next col_label

    row_label = 64

    Loop
   

'move to next paste row
   paste_row = paste_row + 1
   
'sets the next set of data to copy
    row_label = 68
    
'get the name of the SubProject
    Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
    
    Do While Not row_label = 69

    For col_label = 6 To 32
    
'get relevant data and paste into "SubProject Summary" sheet
    Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
    
    Next col_label

    row_label = 69

    Loop
   
        
'move to next paste row
   paste_row = paste_row + 1
   
'sets the next set of data to copy
    row_label = 74
    
'get the name of the SubProject
    Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
    
    Do While Not row_label = 75

    For col_label = 6 To 32
    
'get relevant data and paste into "SubProject Summary" sheet
    Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
    
    Next col_label

    row_label = 75

    Loop
        
'move to next paste row
   paste_row = paste_row + 1
        
        
    Worksheets(current_sheet).Select
    ActiveSheet.Next.Select

Loop

Worksheets("SubProject Summary").Select

End Sub



  


Betrifft: AW: automatisches Makro update?? von: Ansgar
Geschrieben am: 09.09.2004 11:16:42

Habe die angegebene Loesung probiert (Einfach die Sub in meinen Makro in die erste Zeile reingepastet), aber es funktioniert irgendwie nicht. Kann Zellen aendern wie ich will und der Makro kalkuliert nicht neu.
Wenn ich den Button presse, dann klappt es natuerlich...


 

Beiträge aus den Excel-Beispielen zum Thema "automatisches Makro update??"