Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How can I optimize this code?
Hello,
I have many sheets with many checkboxes! My problem is, that th function checks each checkboxes (until Zelle.Address ol.TopLeftCell.Address!), although the address of the searched checkbo is known (Set rng = ws.Cells(z, s)). Is it possible to check only the searched checkbox (=ws.cells(z,s)) i the function? Thanks a lot for help, wullux Sub Auswertung() Dim rng As Range Dim ws As Worksheet Dim j As Integer Dim s As Integer Dim wert As Integer Dim z As Integer Dim lngletztezeile As Integer For j = 1 To Worksheets.Count For s = 2 To 32 wert = 0 lngletztezeile = Worksheets(j).Cells(Worksheets(j).Rows.Count 1).End(xlUp).row For z = 4 To lngletztezeile Set ws = ThisWorkbook.Worksheets(j) Set rng = ws.Cells(z, s) If ZelleHatOLEObject(Zelle:=rng, blatt:=ws) Then wert = wert + 1 Tabelle1.Cells(j, s) = wert End If Next z Next s Tabelle1.Cells(j, 33) = WorksheetFunction.Sum(Cells(j, 2), Cells(j 3)) Next j Set ws = Nothing Set rng = Nothing End Sub Function ZelleHatOLEObject(Zelle As Range, blatt As Worksheet) A Boolean Dim ol As OLEObject ZelleHatOLEObject = False For Each ol In blatt.OLEObjects If Zelle.Address = ol.TopLeftCell.Address Then If ol.Object.Value = True Then ZelleHatOLEObject = True Exit Function End If End If Next ol End Functio -- Message posted from http://www.ExcelForum.com |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How can I optimize this code?
You know the cell, but you don't know which checkbox is over that cell.
Thus you have to loop. the only way to get around this would be to alter the oleObject name of the checkbox so it can be constructed from the cell address. for instance cboxB9 sStr = "cbox" & wsCells(z,s).Address(0,0) set oleobj = Nothing on Error Resume Next set oleobj = ws.OleObjects(sStr) On Error goto 0 if not oleObj is nothing then wert = wert + 1 -- Regards, Tom Ogilvy wullux wrote in message ... Hello, I have many sheets with many checkboxes! My problem is, that the function checks each checkboxes (until Zelle.Address = ol.TopLeftCell.Address!), although the address of the searched checkbox is known (Set rng = ws.Cells(z, s)). Is it possible to check only the searched checkbox (=ws.cells(z,s)) in the function? Thanks a lot for help, wullux Sub Auswertung() Dim rng As Range Dim ws As Worksheet Dim j As Integer Dim s As Integer Dim wert As Integer Dim z As Integer Dim lngletztezeile As Integer For j = 1 To Worksheets.Count For s = 2 To 32 wert = 0 lngletztezeile = Worksheets(j).Cells(Worksheets(j).Rows.Count, 1).End(xlUp).row For z = 4 To lngletztezeile Set ws = ThisWorkbook.Worksheets(j) Set rng = ws.Cells(z, s) If ZelleHatOLEObject(Zelle:=rng, blatt:=ws) Then wert = wert + 1 Tabelle1.Cells(j, s) = wert End If Next z Next s Tabelle1.Cells(j, 33) = WorksheetFunction.Sum(Cells(j, 2), Cells(j, 3)) Next j Set ws = Nothing Set rng = Nothing End Sub Function ZelleHatOLEObject(Zelle As Range, blatt As Worksheet) As Boolean Dim ol As OLEObject ZelleHatOLEObject = False For Each ol In blatt.OLEObjects If Zelle.Address = ol.TopLeftCell.Address Then If ol.Object.Value = True Then ZelleHatOLEObject = True Exit Function End If End If Next ol End Function --- Message posted from http://www.ExcelForum.com/ |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
How can I optimize this code?
Hello Tom,
Thank you very much for your Help!!! I now solved the problem this way... Regards, wullux Sub Auswertung() Dim rng As String Dim ws As Worksheet Dim j As Integer Dim wert As Integer Dim z As Integer Dim lngletztezeile As Integer Dim ol As OLEObject Dim s As String For j = 1 To Worksheets.Count For Each ol In Worksheets(j).OLEObjects Application.EnableEvents = False rng = ol.TopLeftCell.Address s = Mid(rng, 2, InStr(2, rng, "$") - 2) z = Right(rng, Len(rng) - InStr(2, rng, "$")) If ol.Object.Value = True Then If Worksheets(j).Cells(z, 1).Value = "Ausgefallen" Then Tabelle1.Cells(j, Columns(s).column).Interior.ColorIndex = 3 GoTo nextol End If wert = Tabelle1.Cells(j, Columns(s).column).Value wert = wert + 1 Tabelle1.Cells(j, Columns(s).column).Value = wert End If nextol: Next ol Application.EnableEvents = True On Error GoTo 1 Tabelle1.Cells(j, 33) = WorksheetFunction.Sum(Cells(j, 2), Cells(j 3)) 1: Next j Exit Sub End Su -- Message posted from http://www.ExcelForum.com |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
HELP! optimize calculating values | Excel Discussion (Misc queries) | |||
Optimize simple macro | Excel Worksheet Functions | |||
Optimize SumProduct | Excel Discussion (Misc queries) | |||
Optimize SumProduct | Excel Worksheet Functions | |||
Macro too slow...how to optimize | Excel Programming |