Anzeige
Archiv - Navigation
668to672
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
668to672
668to672
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

äussere + innere Schleife

äussere + innere Schleife
18.09.2005 19:09:16
Kerstin
Hallo Gemeinde,
vielleicht kann mir jemand auf die Sprünge helfen. Brauche mehrere verschachtelte schleifendurchläufe.
Habe Mappe2 bis Mappe10 auf dem Desktop und in jedem Tabellenblatt1 sollen die folgenden Aktionen ausgeführt werden.
Gehe in Mappe2
Gehe in Zelle E5 - dividiere C5/D5 - mache das solange bis letzter Wert in Spalte gefunden.
Gehe in Zelle F5 - multipliziere B5*C5/D5 - mache das solange bis letzter Wert in Spalte gefunden.
Gehe in Mappe3
....
bis Mappe 10
Danke und Gruß Kerstin

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: äussere + innere Schleife
18.09.2005 19:42:58
Josef
Hallo Kerstin!
Ungetestet, sollte aber laufen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
  pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib _
  "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
  As Long, pidl As ITEMIDLIST) As Long


Private Type ITEMID
  cb As Long
  abID As Byte
End Type

Private Type ITEMIDLIST
  mkid As ITEMID
End Type


' Desktop
Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10


Private Const NOERROR As Long = 0&

Private Sub ChangeFiles()
Dim wkb As Workbook
Dim ws As Worksheet
Dim fs As FileSearch
Dim n As Integer
Dim lRow As Long

On Error GoTo ERREXIT

With Application
  .EnableEvents = False
  .ScreenUpdating = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

Set fs = Application.FileSearch

With fs
  .NewSearch
  .LookIn = GetPath(CSIDL_DESKTOPDIRECTORY)
  .FileType = msoFileTypeExcelWorkbooks
  .Execute
  
  For n = 1 To .FoundFiles.Count
    
    Set wkb = Workbooks.Open(.FoundFiles(n))
    
    For Each ws In wkb.Worksheets
      
      lRow = ws.Range("C65536").End(xlUp).Row
      
      ws.Range(ws.Cells(5, 5), ws.Cells(lRow, 5)).FormulaR1C1 = "=RC[-2]/RC[-1]"
      ws.Range(ws.Cells(5, 6), ws.Cells(lRow, 6)).FormulaR1C1 = "=RC[-4]*RC[-3]/RC[-2]"
      ws.Calculate
      ws.Range(ws.Cells(5, 5), ws.Cells(lRow, 5)) = ws.Range(ws.Cells(5, 5), ws.Cells(lRow, 5)).Value
      ws.Range(ws.Cells(5, 6), ws.Cells(lRow, 6)) = ws.Range(ws.Cells(5, 6), ws.Cells(lRow, 6)).Value
      
    Next
    
    wkb.Close True
    Set wkb = Nothing
    
  Next
  
End With

ERREXIT:
If Err.Number > 0 Then
  MsgBox Err.Description & vbLf & Err.Number, vbExclamation, "Fehler"
End If
With Application
  .EnableEvents = True
  .ScreenUpdating = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With
End Sub


Private Function GetPath(Num As Long) As String
Dim Result As Long
Dim Buff As String
Dim idl As ITEMIDLIST

Result = SHGetSpecialFolderLocation(0, Num, idl)
If Result = NOERROR Then
  Buff = Space$(512)
  Result = SHGetPathFromIDList(ByVal idl.mkid.cb, ByVal Buff)
  If Result Then
    GetPath = Left(Buff, InStr(Buff, Chr(0)) - 1)
  End If
End If
End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: äussere + innere Schleife
18.09.2005 20:03:55
Kerstin
Hallo Sepp,
danke für Deine schnelle Antwort.
funktioniert bestens!!!!!!!!!!
jetzt kommt aber ein kleines Problemchen
Habe mich blöd ausgedrückt. Ich habe eine Application mir erstellt, welche mir aus einer Anwendung herraus 9 Mappen (mit den Namen Mappe2 - Mappe10) erstellt.
Diese werden nur geöffnet und nicht wie erst beschrieben auf dem Desktop abgelegt - sorry.
Kannst Du mir bitte Dein Makro daraufhin anpassen.
Gruß Kerstin
AW: äussere + innere Schleife
18.09.2005 20:24:11
Josef
Hallo Kerstin!
Dann sollte das genügen!
Private Sub ChangeFiles()
Dim wkb As Workbook
Dim ws As Worksheet
Dim n As Integer
Dim lRow As Long
Dim blnRightName As Boolean

On Error GoTo ERREXIT

With Application
  .EnableEvents = False
  .ScreenUpdating = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With



For Each wkb In Application.Workbooks
  
  blnRightName = False
  
  For n = 2 To 9
    If wkb.Name = "Mappe" & n Then
      blnRightName = True
      Exit For
    End If
  Next
  
  If blnRightName Then
    
    For Each ws In wkb.Worksheets
      
      lRow = ws.Range("C65536").End(xlUp).Row
      If lRow < 5 Then lRow = 5
      
      ws.Range(ws.Cells(5, 5), ws.Cells(lRow, 5)).FormulaR1C1 = "=RC[-2]/RC[-1]"
      ws.Range(ws.Cells(5, 6), ws.Cells(lRow, 6)).FormulaR1C1 = "=RC[-4]*RC[-3]/RC[-2]"
      ws.Calculate
      ws.Range(ws.Cells(5, 5), ws.Cells(lRow, 5)) = ws.Range(ws.Cells(5, 5), ws.Cells(lRow, 5)).Value
      ws.Range(ws.Cells(5, 6), ws.Cells(lRow, 6)) = ws.Range(ws.Cells(5, 6), ws.Cells(lRow, 6)).Value
      
    Next
    
    Set wkb = Nothing
    
  End If
  
Next

ERREXIT:
If Err.Number > 0 Then
  MsgBox Err.Description & vbLf & Err.Number, vbExclamation, "Fehler"
End If
With Application
  .EnableEvents = True
  .ScreenUpdating = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: äussere + innere Schleife
18.09.2005 20:34:26
Kerstin
Super
Danke Sepp - komme meinem Ziel dank Deiner Hilfe immer näher.
Gruß und Guten Abend
Kerstin
AW: äussere + innere Schleife
19.09.2005 04:48:06
Kerstin
Hallo Sepp,
vielleicht liest Du ja dies am heutigen Tag noch. Habe Nachtschicht und bin auf ein Problem gestoßen.
Meine Arbeitsmappen werden, wenn sie von meiner Application generiert werden, als eigenständige Mappen in Excel geführt. In der Statusleiste sind alle aufgeführt aber wenn ich im Excelmenü unter Fenster gehe, steht jeweils nur die Mappe drin welche gerade aktiv ist. Wenn ich jetzt meine Datei mit Deinem Makro aufrufe wird die Makroanwendung nur auf die letzte generierte mappe10 angewandt da sich die Makroexceldatei zu der Gruppe mit Mappe10 im Fenstermenü begeben hat.
Ich hoffe, dass ich mich etwas verständlich ausgedrückt habe.
Gruß Kerstin
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige