PDA

View Full Version : [SOLVED] Make my Code work faster



MokA
10-01-2015, 11:57 PM
Hi,
im pretty new to VBA and Excel and Programming at all.
I finally figured out a Code thats exactly does what want, but i just think its to slow.
Do you have any suggestion how to make the execute faster?


Sub AddRemove()


Dim helfer As Range
Dim Tabelle As ListObject
Dim i As Integer
i = 3
j = 1
Set helfer = Selection
Set Tabelle = Range("SummeMA").ListObject
Zelle = helfer.EntireRow.Cells(1, i).Address(0, 0)


If Range(Tabelle).Cells(3, j).HasFormula = True And InStr(1, Range(Tabelle).Cells(3, j).Formula, "-" & Zelle) <> 0 Then

' Formel entfernen

While i < 55

Zelle = helfer.EntireRow.Cells(1, i).Address(0, 0)

alteFormel = Range(Tabelle).Cells(3, j).Formula
neueFormel = Replace(alteFormel, "-" & Zelle, "")
Range(Tabelle).Cells(3, j).Formula = neueFormel

i = i + 1
j = j + 1

Wend

' Grün einfärben

helfer.EntireRow.Cells(1, 1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
helfer.EntireRow.Cells(1, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With



Else
' Formel hinzufügen
While i < 55

Zelle = helfer.EntireRow.Cells(1, i).Address(0, 0)


alteFormel = Range(Tabelle).Cells(3, j).Formula
neueFormel = alteFormel + "-" & Zelle
Range(Tabelle).Cells(3, j).Formula = neueFormel

i = i + 1
j = j + 1
Wend
' Ursprung herstellen
helfer.EntireRow.Cells(1, 1).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
helfer.EntireRow.Cells(1, 2).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With


End If

End Sub



I'll upload the Worksheet to so you can test it youreself
14489

Greetings
MoKa

snb
10-02-2015, 12:31 AM
Kennst du http://www.office-loesung.de/p/ ?

p45cal
10-02-2015, 08:58 AM
try:
Sub AddRemove()
Dim helfer As Range, Zelle As String, alteFormel As String

Set helfer = Selection
Zelle = helfer.EntireRow.Cells(1, 3).Address(0, 0)
With Range("SummeMA").ListObject.Range.Cells(3, 1)
alteFormel = .Formula
If .HasFormula And InStr(1, alteFormel, "-" & Zelle) <> 0 Then
' Formel entfernen
.Resize(, 52).Formula = Replace(alteFormel, "-" & Zelle, "")
' Grün einfärben
With Cells(helfer.Row, 1).Resize(, 2).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Else
' Formel hinzufügen
.Resize(, 52).Formula = alteFormel + "-" & Zelle
' Ursprung herstellen
Cells(helfer.Row, 1).Resize(, 2).Interior.Pattern = xlNone
End If
End With
End Sub

jolivanes
10-03-2015, 11:48 AM
Oder
http://xlforum.herber.de/

MokA
10-04-2015, 10:21 PM
Wow that Code is fast, thank you so much!!!!!!

ich werd die anderen beiden Foren gleich mal auschecken, danke auch dafür!

I have a question about your code.

Zelle = helfer.EntireRow.Cells(1, 3).Address(0, 0)
Here we safe Zelle as e.g. C27
You never change it again, so how does Excel know that it's supposed to go along the Row until BB27?
In this code, i guess, you only go along the SummeMATable till the end.

.Resize(, 52).Formula = Replace(alteFormel, "-" & Zelle, "")

p45cal
10-05-2015, 05:46 AM
Zelle = helfer.EntireRow.Cells(1, 3).Address(0, 0)
Here we safe Zelle as e.g. C27
You never change it again, so how does Excel know that it's supposed to go along the Row until BB27?
In this code, i guess, you only go along the SummeMATable till the end.

.Resize(, 52).Formula = Replace(alteFormel, "-" & Zelle, "")It's the way Excel handles cell references when pasting or copying formulae. C27 is a relative reference, and you chose it by using .Address(0,0). Had it been .Address it would have been $C$27, an absolute address that Excel would have held in all the formulae as $C$27.

MokA
10-05-2015, 07:39 AM
Hi p45cal,
thank you very much, now i get it, thanks.

Unfortunatly i have a new Problem, and i am really concerned that i have to rework my code all over again.
My 1. Worksheet works perfectly smooth know.
But i need 6 worksheets at all, 5 excatly like the one i created allready.
But i cant give them the same Table names, even though they are on different worksheets.
All my makros reference to the name of a table, i would have to include all the different Tablenames and then check which Worksheet i am on and then reference to the table.
Is there any other way?
Here is my 1. worksheet again ( until know final version)
14506

greetings MoKa

p45cal
10-05-2015, 08:56 AM
A litle re-writing might be necessary.
A range has a listobject associated with it (if that range is in a table) so you can use the range.listobject to refer to a listobject (you already do that in some of your code).
Although you can't use the same table name on different sheets, you can use the same Name name (as in named range) on different sheets.
So if you name the top left cell of a table (because it won't disappear with changing table size, and it will move with inserting/deleting rows and move with the table if the table is moved) "FirstTable", this name will have, by default a global scope. You can reduce its scope (make it local) to just the sheet by choosing that scope (a sheet) in the Scope field dropdown of the New Name dialogue box.
You'd use it in code and it would refer to the active sheet version (or if the code is in a sheet code module, that sheet) just the same as when you refer to a cell by its address.
When you copy a sheet, the local name is copied too and refers to the copied sheet.
Internally the name is actually like: 'CoC Ausstattung'!FirstTable
So in your code you'd refer to the same listobject on different sheets thus:
Range("FirstTable").listobject
I really don't know if this is the best way; there might be a better or 'proper' way to do it.

MokA
10-08-2015, 10:18 PM
Hi p45cal,

im having a problem with your code,
you safe alteFormel as Range("SummeMA").ListObject.Range.Cells(3, 1).Formula and then write it in all Cells, but
Range("SummeMA").ListObject.Range.Cells(3, 1).Formula is not equal to Range("SummeMA").ListObject.Range.Cells(3, 2).Formula

For i now i switched back to my old code style.


With Range(SummeMA).ListObject.Range.Cells(3, 1)
alteFormel = .Formula
If .HasFormula And InStr(1, alteFormel, "-" & Zelle) <> 0 Then
' Formel entfernen
While k < 53
With Range(SummeMA).ListObject.Range.Cells(3, k)
.Resize.Formula = Replace(Range(SummeMA).ListObject.Range.Cells(3, k).Formula, "-" & Zelle, "")
End With
Zelle = Range(Zelle).Offset(, 1).Address(0, 0)
k = k + 1
Wend

and


Else
' Formel hinzufügen
While k < 53
With Range(SummeMA).ListObject.Range.Cells(3, k)
.Resize.Formula = Range(SummeMA).ListObject.Range.Cells(3, k).Formula + "-" & Zelle

End With
Zelle = Range(Zelle).Offset(, 1).Address(0, 0)
k = k + 1
Wend
but now this code is really slow again ^^

Maybe you know another way to make it faster.

Greeting MoKa

p45cal
10-09-2015, 02:01 AM
Attach a file which has both versions of the AddRemove code, both your current correct one and my incorrect one.
Make sure the formulae in the row are all correct.
In your next message here point out the difference between the 2 formulae by copying them from the cell to the message.

p45cal
10-09-2015, 03:28 AM
I think I see what might be going wrong; in your original file (attached to msg#1) there is an inconsistency of formulae in cells C33 and D33 (Excel shows this in cell D33 as a small green triangle). Most cells on row 33 refer to ranges directly above (in the same column), these cells don't. I saw this and 'corrected' it so that those two cells also referred to ranges directly above them too; was I wrong to do that?
My code relies on the formula in C33 as a basis for all the formulae on that row, so it has to be correct.
Does this solve it?

Otherwise, I have double checked the code, and if I'm right about the inconsistencies being wrong, the formulae returned by both our codes are the same.

p45cal
10-18-2015, 02:28 AM
Did this solve it?

MokA
10-21-2015, 12:50 AM
Hi p45cal,

I am really sorry for my late response....
Yes it did help my Problem thank you very much!!!!

My Excel Project is now in Beta-Test, hopefully everything will work fine.
Thank you again!!

Greetings
Moka