Forum » Programiranje » Visual Basic - pomoč pri kodi (Excel)
Visual Basic - pomoč pri kodi (Excel)
koli99 ::
Prvo naj omenim da nisem programer. Tako da kakršna koli pomoč bo dobrodošla.
Imam en .xls file. V njem bo na prvi strani (Sheet1 -> "DELOVNI NALOG") baza podatkov, kdo in kaj se je delalo, etc, pod določenimi projekti...
Sledili bodo delovni listi z številkami projektov (360, 374,...).
Rad bi, da macro kopira podatke iz prvega delovnega lista ter jih razporedi v svoje projekte. Prvi delovni list bo posodobljen dnevno in rad bi da macro posodobi delovne liste s projekti.
Koda je zaenkrat taka (pomoč iz Excelforum):
Sub koli99()
Dim i As Long
Dim x As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = ActiveSheet
For Each ws2 In ActiveWorkbook.Worksheets
If IsNumeric(ws2.Name) Then
ws2.Activate
Rows("5:100").ClearContents
End If
Next ws2
ws.Activate
For i = 5 To Range("D" & Rows.count).End(3)(1).Row
x = Range("D" & i).Value
Range(Cells(i, "A"), Cells(i, "K")).Copy Sheets(x).Range("A" & Sheets(x).Range("D" & Rows.count).End(3)(2).Row)
ws.Activate
Next i
End Sub
Imam pa par problemov:
1.) Kljub temu da se prvi delovni list imenuje (DELOVNI NALOG) macro pobriše podatke tudi iz tega lista.
2.) Če delovnega lista s projektom ni ampak je vpisan na prvi strani (recimo projekt 360 ima svoj delovni čist 360, 374 ne), se koda ustavi. Rad bi, da program preskoči vrstico če projekt nima svojega delovnega lista.
Za kakršnokoli pomoč se zahvaljujem!
Lp,
jure
Imam en .xls file. V njem bo na prvi strani (Sheet1 -> "DELOVNI NALOG") baza podatkov, kdo in kaj se je delalo, etc, pod določenimi projekti...
Sledili bodo delovni listi z številkami projektov (360, 374,...).
Rad bi, da macro kopira podatke iz prvega delovnega lista ter jih razporedi v svoje projekte. Prvi delovni list bo posodobljen dnevno in rad bi da macro posodobi delovne liste s projekti.
Koda je zaenkrat taka (pomoč iz Excelforum):
Sub koli99()
Dim i As Long
Dim x As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = ActiveSheet
For Each ws2 In ActiveWorkbook.Worksheets
If IsNumeric(ws2.Name) Then
ws2.Activate
Rows("5:100").ClearContents
End If
Next ws2
ws.Activate
For i = 5 To Range("D" & Rows.count).End(3)(1).Row
x = Range("D" & i).Value
Range(Cells(i, "A"), Cells(i, "K")).Copy Sheets(x).Range("A" & Sheets(x).Range("D" & Rows.count).End(3)(2).Row)
ws.Activate
Next i
End Sub
Imam pa par problemov:
1.) Kljub temu da se prvi delovni list imenuje (DELOVNI NALOG) macro pobriše podatke tudi iz tega lista.
2.) Če delovnega lista s projektom ni ampak je vpisan na prvi strani (recimo projekt 360 ima svoj delovni čist 360, 374 ne), se koda ustavi. Rad bi, da program preskoči vrstico če projekt nima svojega delovnega lista.
Za kakršnokoli pomoč se zahvaljujem!
Lp,
jure
samotest ::
ad1) sem poskusil in na prvem listu je pustilo nedotaknjeno.. vsaj kot sem poimenoval predvidene zavihke (NALOG, BAZA, 374) in kopiral tvojo kodo, kot je sedaj prikazano spodaj.
ad2) urejeno s spodnjo kodo
---------
Sub koli99()
Dim i As Long
Dim x As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = ActiveSheet
For Each ws2 In ActiveWorkbook.Worksheets
If IsNumeric(ws2.Name) Then
ws2.Activate
Rows("5:100").ClearContents
End If
Next ws2
ws.Activate
For i = 5 To Range("D" & Rows.Count).End(3)(1).Row
x = Range("D" & i).Value
If SheetExists(x) Then
Range(Cells(i, "A"), Cells(i, "K")).Copy Sheets(x).Range("A" & Sheets(x).Range("D" & Rows.Count).End(3)(2).Row)
End If
ws.Activate
Next i
End Sub
Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If
NoSuchSheet:
End Function
ad2) urejeno s spodnjo kodo
---------
Sub koli99()
Dim i As Long
Dim x As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = ActiveSheet
For Each ws2 In ActiveWorkbook.Worksheets
If IsNumeric(ws2.Name) Then
ws2.Activate
Rows("5:100").ClearContents
End If
Next ws2
ws.Activate
For i = 5 To Range("D" & Rows.Count).End(3)(1).Row
x = Range("D" & i).Value
If SheetExists(x) Then
Range(Cells(i, "A"), Cells(i, "K")).Copy Sheets(x).Range("A" & Sheets(x).Range("D" & Rows.Count).End(3)(2).Row)
End If
ws.Activate
Next i
End Sub
Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If
NoSuchSheet:
End Function
Zgodovina sprememb…
- spremenil: samotest ()
Vredno ogleda ...
Tema | Ogledi | Zadnje sporočilo | |
---|---|---|---|
Tema | Ogledi | Zadnje sporočilo | |
» | vba arrayOddelek: Programiranje | 922 (615) | Vazelin |
» | Excel: tiskanje po vrsticahOddelek: Pomoč in nasveti | 1104 (1017) | luksorzi |
» | [Excel]Kako izvleči vrednost?Oddelek: Programiranje | 3782 (3505) | Mobidick |
» | [Excel] problem z makrojem, visual basic (strani: 1 2 )Oddelek: Programiranje | 5658 (5121) | steev |
» | [Visual studio .NET] Rabim pomočOddelek: Programiranje | 1593 (1435) | darkolord |