vbamania.pl
login:
hasło:
 
  *Rejestracja *Zapomniane hasło
 Dziś jest poniedziałek, 29 kwietnia 2024 roku.
Ustaw jako stronę startową Ulubione Napisz
PowrótPowrót do serwisu  RegulaminRegulamin rssRSS

  tytuł wątku:
Wątki dyskusji

Prośba o uproszczenie kodu.


otwartyotwarty rozpoczął: jamanow postów: 4



napisał: Trebor
postów: 1209


umieszczony:
15 lipca 2012
18:31

edytowany:
15 lipca 2012
18:32

  
Nigdy się w takie rzeczy nie bawiłem. Kody piszę w dwojaki sposób:
1. Tak, aby był łatwy do analizy tj. krótko i przejrzyście
2. Gdy napisany jak powyżej, wykonuje się zbyt długo, przepisuję (komplikuję) go wykorzystując przeważnie tablice.

Innych uwarunkowań nie stosuję.
napisał: jamanow
postów: 69


umieszczony:
15 lipca 2012
10:55

  
nazwa pliku rozmiar
VBA-compare.jpg 203.96 kB

Dzięki Trebor za pomoc i pouczające komentarze.
Czy możesz zarekomendować jakies narzedzie do porównywania dwóch wersji kodu, które pokazywałoby różnice w porównywanych wersjach. Cos podobnego do tego jag robi to Total Commander , załączam przykład.
TC działa pięknie po za tym ze trzeba kopiować i wklejać
napisał: Trebor
postów: 1209


umieszczony:
15 lipca 2012
10:25

  
Poniżej wplecione moje uwagi
Public Sub SheetIndexWith_wsIndexNumer()
Dim wrsAktivtBlad As Worksheet
Dim wrbBok As Workbook
Dim ws As Worksheet
Dim iRow As Long
Dim sh$

On Error Resume Next
sh = Sheets("Index").Name
On Error GoTo 0

If sh <> "" Then
Sheets("Calculation").Activate
Else
Worksheets.Add.Name = "Index"
End If



With Sheets("Index")
.Range("A1:A" & CStr(.Rows.Count)).ClearContents
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'.Columns(1).ClearContents
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
End With
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Set wrsAktivtBlad = ActiveSheet
'nie ma pewności czy to jest Index czy Calculation
iRow = 2
For Each ws In Worksheets
    If ws.Name <> "Index" And ws.Name <> "Calculation" And ws.Name <> "Data" Then
    iRow = iRow + 1
    
        With Sheets("Index")
        .Hyperlinks.Add Anchor:=.Cells(iRow, "A"), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:="" & ws.Name
        .Hyperlinks.Add Anchor:=.Cells(iRow, "E"), Address:="", SubAddress:="'" & ws.Name & "'!E1", TextToDisplay:="" & ws.Index
        
            wrsAktivtBlad.Cells(iRow, "B") = ws.Range("E3")
            wrsAktivtBlad.Cells(iRow, "C") = ws.Range("E4")
        
            If ws.Visible = xlSheetVeryHidden Then
                wrsAktivtBlad.Cells(iRow, "D") = "Very Hidden"
            ElseIf ws.Visible = xlSheetHidden Then
                wrsAktivtBlad.Cells(iRow, "D") = "Hidden"
            ElseIf ws.Visible = xlSheetVisible Then
                wrsAktivtBlad.Cells(iRow, "D") = "Visible"
            End If
        End With
    End If
Next ws
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'poniższe polecenia dotyczą aktywnego arkusza
    Columns("A:E").EntireColumn.AutoFit
    'wystarczy,
    'Columns("A:E").AutoFit
    Columns("C:C").NumberFormat = "m/d/yyyy"

'>>
Cells.FormatConditions.Delete 'dotyczy wszystkich komórek
'unikamy wszelkiego rodzaju selectów, czy koniecznie formatowanie warunkowe musi dotyczyć całej kolumny?
With Columns("D:D")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Hidden"""
    With .FormatConditions(1).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Very Hidden"""
    With .FormatConditions(2).Font
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
    End With
.FormatConditions(2).StopIfTrue = False
End With
'<<
    
Range("A1").Select
End Sub

napisał: jamanow
postów: 69


umieszczony:
14 lipca 2012
11:52

  
Witam.
Mam kod indeksujący skoroszyt, który dział dokładnie tak jak chce.
Budowałem go na zasadzie: nagraj, podglądaj, wytnij, wklej i zdaje sobie sprawę ze jest daleki od poprawnego.
Option Explicit

Public Sub SheetIndexWith_wsIndexNumer()
Dim wrsAktivtBlad As Worksheet
Dim wrbBok As Workbook
Dim ws As Worksheet
Dim iRow As Long
Dim sh$

On Error Resume Next
sh = Sheets("Index").Name
On Error GoTo 0

If sh <> "" Then
Sheets("Calculation").Activate
Else
Worksheets.Add.Name = "Index"
End If



With Sheets("Index")
.Range("A1:A" & CStr(.Rows.Count)).ClearContents
End With

Set wrsAktivtBlad = ActiveSheet
iRow = 2
For Each ws In Worksheets
    If ws.Name <> "Index" And ws.Name <> "Calculation" And ws.Name <> "Data" Then
    iRow = iRow + 1
    
        With Sheets("Index")
        .Hyperlinks.Add Anchor:=.Cells(iRow, "A"), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:="" & ws.Name
        .Hyperlinks.Add Anchor:=.Cells(iRow, "E"), Address:="", SubAddress:="'" & ws.Name & "'!E1", TextToDisplay:="" & ws.Index
        
            wrsAktivtBlad.Cells(iRow, "B") = ws.Range("E3")
            wrsAktivtBlad.Cells(iRow, "C") = ws.Range("E4")
        
            If ws.Visible = xlSheetVeryHidden Then
                wrsAktivtBlad.Cells(iRow, "D") = "Very Hidden"
            ElseIf ws.Visible = xlSheetHidden Then
                wrsAktivtBlad.Cells(iRow, "D") = "Hidden"
            ElseIf ws.Visible = xlSheetVisible Then
                wrsAktivtBlad.Cells(iRow, "D") = "Visible"
            End If
        End With
    End If
Next ws
    Columns("A:E").EntireColumn.AutoFit
    Columns("C:C").NumberFormat = "m/d/yyyy"

'>>
Cells.FormatConditions.Delete
Columns("D:D").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Hidden"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
Selection.FormatConditions(1).StopIfTrue = False
Columns("D:D").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Very Hidden"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
    End With
Selection.FormatConditions(1).StopIfTrue = False
'<<
    
Range("A1").Select
End Sub



<-wstecz  1  dalej->
wszystkich stron: 1


Sortuj posty: z