Code verändern, aber wie?

Bild

Betrifft: Code verändern, aber wie?
von: RalfF
Geschrieben am: 02.12.2003 20:00:22


Hallo Exceler, ich habe ein Problem mit dem unten aufgeführten Code. Der ist super in der Anwendung, sollte aber dennoch eine kleine Verbesserung bekommen. Er holt aus den ersten 3 Blättern der Datei Daten und bringt sie auf das 4te Dateiblatt. Soweit so gut. Kann man den Code (und wie?) so ändern, das die Daten die auf das 4te Blatt gebracht werden, einen Abstand von 15 Reihen(z:b den ersten Block von A1 bis A25 einfügen, dann von A40 usw.) bekommen? In der jetzigen Variante haben die Daten nur 1 Spalte als Leerzeile. Würde mich freuen wenn ihr dafür eine Lösung finden könntet, ich selber habe keine rechte Ahnung über VB. Danke, Ralf


Sub aktual() 
Application.ScreenUpdating = False For i = 1 To 3 Sheets(i).Activate Range("B11").Select Range(Selection, Selection.End(xlDown)).Select For Each cell In Selection If cell.Value > 99999 Then konto = cell.Value End If cell.Offset(0, -1).Value = konto Next Next i Dim y As Integer Sheets(4).Activate Range("a1").Activate For i = 1 To 3 Sheets(4).Activate ActiveCell.Offset(1, 0).Activate Sheets(i).Activate Range("B11").Select Range(Selection, Selection.End(xlDown)).Select For Each cell In Selection If cell.Offset(0, -1).Value > 99999 Then Sheets(4).Activate If ActiveCell.Offset(-1, 0).Value <> cell.Offset(0, -1).Value Then ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 2).Value If IsEmpty(cell.Offset(-1, 3).Value) = False Then ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 3).Value End If ActiveCell.Value = cell.Offset(0, -1).Value ActiveCell.Offset(1, 0).Activate End If If ActiveCell.Offset(-1, 0).Value = cell.Offset(0, -1).Value Then If IsEmpty(cell.Offset(0, 3).Value) = True Then ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 2).Value End If If IsEmpty(cell.Offset(0, 3).Value) = False Then ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 3).Value End If End If Sheets(i).Activate ActiveCell.Offset(1, 0).Activate End If Next Next i For i = 1 To 3 Sheets(i).Activate Range("B11").Select Range(Selection, Selection.End(xlDown)).Select For Each cell In Selection If cell.Value > 99999 Then konto = cell.Value End If cell.Offset(0, -1).ClearContents Next Next i Application.ScreenUpdating = True End 

Sub  
Bild


Betrifft: AW: Code verändern, aber wie?
von: PeterW
Geschrieben am: 02.12.2003 20:03:32

Hallo Ralf,

glaubst du wirklich, dass sich bei dieser Darstellung jemand mit dem Code befasst? Wofür gibt es hier ein Vorschaufenster???

Gruß
Peter


Bild


Betrifft: AW: Code verändern, aber wie?
von: RalfF
Geschrieben am: 02.12.2003 20:08:11


Hallo Peter,

sorry, ich habe das zu spät erkannt. Hier ein neuer Versuch. Gruß, Ralf

Hallo Exceler, ich habe ein Problem mit dem unten aufgeführten Code. Der ist
super in der Anwendung, sollte aber dennoch eine kleine Verbesserung
bekommen. Er holt aus den ersten 3 Blättern der Datei Daten und bringt sie
auf das 4te Dateiblatt. Soweit so gut. Kann man den Code (und wie?) so
ändern, das die Daten die auf das 4te Blatt gebracht werden, einen Abstand
von 15 Spalten bekommen? In der jetzigen Variante haben die Daten nur 1
Spalte als Leerzeile. Würde mich freuen wenn ihr dafür eine Lösung finden
könntet, ich selber habe keine rechte Ahnung über VB. Danke, Ralf



Sub aktual() 
Application.ScreenUpdating = False 
For i = 1 To 3 
Sheets(i).Activate 
Range("B11").Select 
Range(Selection, Selection.End(xlDown)).Select 
For Each cell In Selection 
If cell.Value > 99999 Then 
konto = cell.Value 
End If 
cell.Offset(0, -1).Value = konto 
Next 
Next i 
Dim y As Integer 
Sheets(4).Activate 
Range("a1").Activate 
For i = 1 To 3 
Sheets(4).Activate 
ActiveCell.Offset(1, 0).Activate 
Sheets(i).Activate 
Range("B11").Select 
Range(Selection, Selection.End(xlDown)).Select 
For Each cell In Selection 
If cell.Offset(0, -1).Value > 99999 Then 
Sheets(4).Activate 
If ActiveCell.Offset(-1, 0).Value <> cell.Offset(0, -1).Value Then 
ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 2).Value 
If IsEmpty(cell.Offset(-1, 3).Value) = False Then 
ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 3).Value 
End If 
ActiveCell.Value = cell.Offset(0, -1).Value 
ActiveCell.Offset(1, 0).Activate 
End If 
If ActiveCell.Offset(-1, 0).Value = cell.Offset(0, -1).Value Then 
If IsEmpty(cell.Offset(0, 3).Value) = True Then 
ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 2).Value 
End If 
If IsEmpty(cell.Offset(0, 3).Value) = False Then 
ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 3).Value 
End If 
End If 
Sheets(i).Activate 
ActiveCell.Offset(1, 0).Activate 
End If 
Next 
Next i 
For i = 1 To 3 
Sheets(i).Activate 
Range("B11").Select 
Range(Selection, Selection.End(xlDown)).Select 
For Each cell In Selection 
If cell.Value > 99999 Then 
konto = cell.Value 
End If 
cell.Offset(0, -1).ClearContents 
Next 
Next i 
Application.ScreenUpdating = True 
End 

Sub 


Bild


Betrifft: noch offen
von: PeterW
Geschrieben am: 02.12.2003 20:25:28

Hallo Ralf,

sieht viel besser aus. :-) Aber bei all den Offset und ActiveCell verliere zumindest ich den Überblick. :-(

Gruß
Peter


Bild


Betrifft: immer noch offen, daher HIEEELFE
von: Ralf
Geschrieben am: 03.12.2003 19:40:03

Kann mir denn wirklich keiner helfen?


Bild


Betrifft: AW: immer noch offen, daher HIEEELFE
von: PeterW
Geschrieben am: 04.12.2003 00:02:52

Hallo Ralf,

poste deine Frage erneut - mit dem Hinweis, dass sie bislang nicht beantwortet werden konnte und einem Link auf diesen Thread.

Gruß
Peter


Bild

Beiträge aus den Excel-Beispielen zum Thema " Sub per Tastenkombination starten?"