Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Zeilen einzeln durchgehen und abarbeiten...

Frage Entwicklung VB for Applications

Mitglied: RicoTumb

RicoTumb (Level 1) - Jetzt verbinden

11.08.2008, aktualisiert 13.08.2008, 8724 Aufrufe, 3 Kommentare

Hallo zusammen,



ich habe folgendes Problem:


ich habe einen Code, mit dem ich mehrere Dateien öffnen und dann jeweils einen bestimmten Bereich in ein seperates Sheet kopieren kann. Das ist zwar schon ganz gut, jedoch nicht genau das, was ich brauche! =(

Die Sheets die eingelesen werden haben alle das selbe Muster! Der wichtigeste Bereich sind hier die Zellen B16 bis B30 und Q16 bis Q30 (Tätigkeit und dazugehörige Stunden).

Mein Makro soll nun (falls in dem Zellenbereich eine Tätigkeit mit mehr als 0 Stunden eingetragen ist) diese Tätigkeit in Spalte B meines seperaten Sheets übertragen. Die Stunden sollen in Spalte F eingetragen werden. (Wichtig ist einfach, dass nicht der komplette Spaltenbereich, sondern nur die mit Tätigkeit und Stunden gefüllten Zeilen übertragen werden).
Nun noch eine kleinigkeit. In jedem Sheet das eingelesen wird, steht in Zelle C6 ein Namenskürzel und in Zelle C2 die momentane Kalenderwoche! Wäre es möglich, dass bei jedem eingelesenen Sheet in die Spalte A der entsprechende Namenskürzel und in Spalte D die entsprechende Kalenderwoche übertragen wird.

--> ich hätte dann folgendes Muster für EIN eingelesenes Sheet mit 3 verschiedenen Tätigkeiten:

Spalte A: 3 x der Namenskürzel
Spalte B: 3 verschiedene Tätigkeiten
Spalte D: 3 x die Kalenderwoche
Spalte F: 3 x die zu den Tätigkeiten gehörenden Stunden

Wäre sowas möglich??? Hoffe ich konnte alles ausführlich erklären! Hab schon einiges versucht, aber komme nicht drauf. Ich nehmen an das muss irgendwie mit For-Schleifen und If Bedingungen gemacht werden...

Ich poste auch gleich mal den Code den ich bisher habe. Es müsste wohl nur der letzte Teil angepasst werden, da das vorherige einfach nur das Auswählen der Dateien ist.

Vielen herzlichen Dank im voraus! Wäre super wenn mir jemand helfen könnte! =) Bin langsam am Verzweifeln...

Beste Grüße,
RicoTumb



Sub DateiAuswaehlen()
\'modifiziert am 18.06.2008
Dim strdateiname, strAlleNamen As String
strdateiname = Dateiauswahl()
Dim n As Integer

If IsArray(strdateiname) Then \'Mehrere Dateien ausgewählt
\'Alle Namen in Eine Variable mit Zeilenumbruch zusammenfügen
strAlleNamen = Join(strdateiname, vbLf)
\'Anzeige der ausgewählten Dateinamen
If MsgBox(strAlleNamen, vbYesNo, \"Diese Dateein bearbeiten ?\") = vbYes Then
\'Alternativ : Zugriff auf einzelne Namen per Schleife :
For n = 1 To UBound(strdateiname)
\'MsgBox strDateiname(n), vbOKOnly, \"Datei Nr. \" & n
DateiBearbeiten strdateiname(n)
Next
End If
Else
If strdateiname <> \"\" Then DateiBearbeiten strdateiname
End If
End Sub

Function Dateiauswahl()
Dim strdateiname

\'Multiselect:=TRUE bedeutet : Es können mehrere Dateien ausgewählt werden
\'Multiselect:=FALSE bedeutet : Es kann nur EINE Datei ausgewählt werden
strdateiname = Application.GetOpenFilename( _
FileFilter:=\"Excel-Dateien (*.xls), *.xls\", _
Title:=\"Datei auswählen\", MultiSelect:=True)

If TypeName(strdateiname) = \"Boolean\" Then \'Abgebrochen
Dateiauswahl = \"\"
Else
Dateiauswahl = strdateiname
End If
End Function

Sub DateiBearbeiten(strdateiname)
Dim lngLZ As Long
Dim r1 As Range
Dim r As Range
Dim s As Worksheet

Set s = Sheets(\"Liste\")
Range(\"A1:IV1\") = \"Titel\"

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open strdateiname
With Workbooks(\"Auflistung.xls\").Sheets(\"Liste\")
lngLZ = .Cells(Rows.Count, 2).End(xlUp).Row \'letzte Zeile der Spalte B ermitteln
If lngLZ = 1 Then lngLZ = 0
Worksheets(2).Range(\"B16:B30\", \"Q16:Q30\").Copy \'aus erstem Tabellenblatt Bereich B16:B30 kopieren

Set r1 = .Cells(lngLZ + 1, 2)

r1.PasteSpecial Paste:=xlValues, skipblanks:=True \'Unterhalb letzte Zeile der Spalte B einfügen

End With

ActiveWorkbook.Close False
Application.ScreenUpdating = True

End Sub
Mitglied: bastla
11.08.2008 um 18:08 Uhr
Hallo RicoTumb und willkommen im Forum!

Das letzte Sub könnte etwa so aussehen:
01.
Sub DateiBearbeiten(strdateiname) 
02.
Dim lngLZ As Long, i As Integer 
03.
Range("A1:IV1") = "Titel" 
04.
 
05.
Application.ScreenUpdating = False 
06.
Application.DisplayAlerts = False 
07.
Workbooks.Open strdateiname 
08.
With Workbooks("Auflistung.xls").Sheets("Liste") 
09.
    lngLZ = .Cells(Rows.Count, 2).End(xlUp).Row 'letzte Zeile der Spalte B ermitteln 
10.
    If lngLZ = 1 Then lngLZ = 0 
11.
 
12.
    For i = 16 To 30 'Zeilen 16 bis 30 enthalten Daten 
13.
        If Worksheets(2).Cells(i, "Q").Value > 0 Then 'Stundenzahl > 0 
14.
            lngLZ = lngLZ + 1 'nächste Zeile in Zieltabelle verwenden 
15.
            .Cells(lngLZ, "A") = Worksheets(2).Range("C6").Value   'Kürzel übertragen 
16.
            .Cells(lngLZ, "B") = Worksheets(2).Cells(i, "B").Value 'Tätigkeit übertragen 
17.
            .Cells(lngLZ, "D") = Worksheets(2).Range("C2").Value   'KW übertragen 
18.
            .Cells(lngLZ, "F") = Worksheets(2).Cells(i, "Q").Value 'Stundenanzahl übertragen 
19.
        End If 
20.
    Next 
21.
 
22.
End With 
23.
 
24.
ActiveWorkbook.Close False 
25.
Application.ScreenUpdating = True 
26.
 
27.
End Sub
Grüße
bastla

P.S.: Für die Formatierung von Code hätten wir hier gleichnamige Tags (siehe Quellcode, Code oder HTML Snippets in der Formatierungshilfe) ...
Bitte warten ..
Mitglied: RicoTumb
13.08.2008 um 13:20 Uhr
Hallo bastla,

1000 mal Danke!! Funktioniert perfekt =))

beste Grüße,

RicoTumb
Bitte warten ..
Mitglied: bastla
13.08.2008 um 13:24 Uhr
Hallo RicoTumb!

Freut mich.

Du könntest dann eigentlich den Beitrag als "erledigt" kennzeichnen.

Grüße
bastla
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(1)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Switche und Hubs
gelöst 2 VLANs, tragged und mit link aggregation oder Verbinden oder einzeln (1)

Frage von ADORSE zum Thema Switche und Hubs ...

Microsoft Office
Excel nur markierte Zeilen ausdrucken? (3)

Frage von Server4Alle zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...