» »

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,...).
 prva stran

prva stran


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

Zgodovina sprememb…

  • spremenil: samotest ()

koli99 ::

Super hvala!


Vredno ogleda ...

TemaSporočilaOglediZadnje sporočilo
TemaSporočilaOglediZadnje sporočilo
»

vba array

Oddelek: Programiranje
12917 (610) Vazelin
»

Excel: tiskanje po vrsticah

Oddelek: Pomoč in nasveti
71094 (1007) luksorzi
»

[Excel]Kako izvleči vrednost?

Oddelek: Programiranje
223773 (3496) Mobidick
»

[Excel] problem z makrojem, visual basic (strani: 1 2 )

Oddelek: Programiranje
585645 (5108) steev
»

[Visual studio .NET] Rabim pomoč

Oddelek: Programiranje
91589 (1431) darkolord

Več podobnih tem