Avatar billede yxos Nybegynder
29. april 2015 - 09:41 Der er 5 kommentarer og
1 løsning

VB kode i Excel - må kunne gøres smartere

Vi opretter nye varer i vores ERP system via upload fra en Excelfil.

Varebeskrivelserne skal gerne være ensartede, og derfor udfører vi en række tweaks på hver varetekst, inden upload:
1. Vi bruger STORE.FORBOGSTAVER()
2. Vi bruger ERSTAT() ud fra et andet ark i Excelfilen, så vi kan erstatte et dynamisk antal.

De nye varer med varetekster ligger i ark "Automakroark"
Erstatningerne ligger i ark "Erstat".
https://www.dropbox.com/s/a86jwyv0h0jpth0/Automakroark.jpg?dl=0
https://www.dropbox.com/s/wk6o61mz4z4waxc/ErstatArk.jpg?dl=0

Ved klik på "Kør" knappen, eksekveres koden, der for hver varelinie gennemlæser alle Erstat-linierne, og erstatter i vareteksten.
Altså, et loop over linierne, med et loop over Erstatningslinierne inden i.

  Dim Erstats  As Integer
  Dim Linier    As Integer
  Dim Lin      As Integer
  Dim Elin      As Integer
 
  Linier = Worksheets("Automakroark").Cells(1, "C").Value
  Erstats = Worksheets("Erstat").Cells(1, "E").Value
  Elin = 1
  Lin = 1

  Sheets("Automakroark").Select
 
' Stort.forbogstav i arbejdscelle:
  Range("D3").Select
  ActiveCell.FormulaR1C1 = "=PROPER(RC[-1])"
' Kopier første linjes formatering til de øvrige
  If Linier > 1 Then
    Range("D3:D3").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("D3:D" & Linier + 2)
  End If
 
  Do While Lin <= Linier

    Elin = 1
    Do While Elin <= Erstats

' Opbyg ny værdi i arbejdscelle
      Range("E" & Lin + 2).Select
      ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-1], """ & _
        Worksheets("Erstat").Cells(Elin, "A").Value & """, """ & _
        Worksheets("Erstat").Cells(Elin, "B").Value & """)"

' Kopier Value til forrige celle
      Selection.Copy
      Range("D" & Lin + 2).Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

      Elin = Elin + 1
    Loop
     
    Lin = Lin + 1
  Loop
 
' Nulstil arbejdsceller
  If Linier > 1 Then
    Range("E3:E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
  End If


Det virker, men jeg har på fornemmelsen, at det ikke er den hurtigste kode jeg har fået banket sammen. Jeg tror også, at det må kunne gøres lidt smartere.
Avatar billede yxos Nybegynder
29. april 2015 - 09:54 #1
Her er Excelfilen, der svarer til eksemplet. Køreklar med knap og kode!
https://www.dropbox.com/s/lcc9ftswl4malhz/test%20Automakroark.xlsm?dl=0
Avatar billede natkatten Mester
29. april 2015 - 19:09 #2
Prøv at kigge på dette:

http://gratisupload.dk/f/8rentvqbor/
Avatar billede yxos Nybegynder
30. april 2015 - 08:21 #3
Det er tæt på det jeg ville have. Rigtig mange tak for det!!!

Jeg ser, at du har udvidet Erstat arket voldsomt med alle kombinationer af store og små bogstaver. Det ville jeg gerne undgå ved, at som det første lave en STORT.FORBOGSTAV() / PROPER().
Så behøver jeg lemlig ikke at definere "ss", "sS", "Ss" og "SS", men kun "Ss".

Tror du at du kan få det ind i din rutine?

Eller skal jeg bare putte min stump kode, som gør det, ind lige før din nye kode?

  Range("D3").Select
  ActiveCell.FormulaR1C1 = "=PROPER(RC[-1])"
  If Linier > 1 Then
    Range("D3:D3").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("D3:D" & Linier + 2)
  End If
Avatar billede yxos Nybegynder
30. april 2015 - 10:41 #4
Din "For Each..." der fjerner dobbelt-spaces virker kun når der er flere varelinier.
Hvis der er kun én varelinie, går den i Idle Loop.
Jeg kan sagtens indsætte et Exit For hvis der kun er én linie, men måske der er en mere elegant måde at gøre det på ?
Avatar billede yxos Nybegynder
30. april 2015 - 11:14 #5
Jeg fandt en løsning, så jeg kan sætte stort forbogstav i alle ord; det har jeg sat forand din kode:

  Linier = dataark.Cells(1, "C").Value
 
' Stort.Forbogstav i alle ord:
  For Each celle In dataark.Range("C3", dataark.Range("C3").End(xlDown))
    celle.Value = StrConv(celle.Value, vbProperCase)
    If Linier = 1 Then  ' Undgå Idle Loop, når der kun er én linje
      Exit For
    End If
  Next celle

Hermed behøver jeg knapt så mange ord i Erstat arket, og med din løsning slipper jeg for, at bruge de to højreste kolonner som arbejdsfelter, men kan arbejde direkte i kolonne C.

Jeg tror vi er ved at være der, så med mindre du har ekstra tilføje, så læg et svar, som jeg kan acceptere.

Tak for hjælpen!
Avatar billede natkatten Mester
30. april 2015 - 11:30 #6
Fint at du kunne bruge det og har arbejdet videre med mit eksempelark. Får ikke kigget på det før i aften. Hvis jeg får gode idéer skal jeg gerne lægge en ny udgave op på GUPL.

/natkatten
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester



Seneste spørgsmål Seneste aktivitet
I dag 06:10 Excel åbner fil i kæmpe format Af Aske i Excel
I går 22:00 Datafordeler Af Lsk i PHP
I går 12:37 Summere beløb pr. dato Af TTA i Excel
31/1022:44 Tilslutte chassic fans Af viking69 i PC
31/1020:28 LED lysstofrør Af ErikHg i Fri debat