Just nu i M3-nätverket
Gå till innehåll

Två värden i ett programhopp.


PeterPAN

Rekommendera Poster

Hej,

 

Jag vill att scriptet skall ta med sig två värden till en ny SUB, men jag får upp syntaxfel. Vad är det jag gör fel?

 

Release = wsTemp2.Range("C" & rwIndex2).Value
ColorCell = wsTemp2.Range("C" & rwIndex2).Interior.ColorIndex

jmfKolumner (Release, colorcell)

Sub jmfKolumner(Release As String, ColorCell As Integer)

 

Länk till kommentar
Dela på andra webbplatser

Deklarerar ALLTID alla variabler!

Inled din modul med

Option Explicit

eller sätt inställningen i VBA till kräva deklaration.

 

Problemet är säkerligen att du inte deklarerat de variabler du skickar och de blir då av Variant-typ.

 

Anropet

Release = wsTemp2.Range("C" & rwIndex2).Value

kan då ta typen efter den typ av värde som finns i cellen, dvs integer, double, sträng.

 

Deklarera Release som en String och ColorCell som Integer så bör problemet vara ur världen.

 

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.

 

Länk till kommentar
Dela på andra webbplatser

 

Nä, det är inte det som är problemet. Skickar med hela koden.

 

Dim rwIndex As Integer, rwIndex1 As Integer, rwIndex2 As Integer, _
colIndex1 As Integer, colIndex2 As Integer, i As Integer, ColorCell As Integer

Dim Rader As Long

Dim ArtNr1 As String, ArtNr2 As String, TransferValue As String, Release As String

Dim wsTemp1 As Worksheet, wsTemp2 As Worksheet

Dim Avsluta, Avsluta2, Omstart

Option Explicit
Sub jmfRader()

'Bladet som informationen förs över till
Set wsTemp1 = Blad2
'Bladet som informationen tas ifrån
Set wsTemp2 = Blad1

rwIndex1 = 2
colIndex1 = 2

'LOOP1 i wsTemp1
Do While wsTemp1.Range("A" & rwIndex1).Value <> ""

'Radindex i wsTemp2 skall alltid börja på rad 2
rwIndex2 = 2

'Läser in värden
Value1 = wsTemp1.Range("A" & rwIndex1).Value

   'LOOP2 i wsTemp2
   Do While wsTemp2.Range("A" & rwIndex2).Value <> ""
   'Läser in art.nr från wsTemp2
   Value2 = wsTemp2.Range("A" & rwIndex2).Value
   i = 1
       'Om art.nr från wsTemp1 är lika med art.nr från wsTemp2
       If Value1 = Value2 Then

Omstart:
           If i = 1 Then

               Release = wsTemp2.Range("B" & rwIndex2).Value
               ColorCell = wsTemp2.Range("B" & rwIndex2).Interior.ColorIndex
               jmfKolumner (Release, colorcell)

               GoTo Omstart

           ElseIf i = 2 Then

               Release = wsTemp2.Range("C" & rwIndex2).Value
               ColorCell = wsTemp2.Range("C" & rwIndex2).Interior.ColorIndex
               jmfKolumner (Release)

               GoTo Omstart

           ElseIf i = 3 Then

               Release = wsTemp2.Range("D" & rwIndex2).Value
               ColorCell = wsTemp2.Range("D" & rwIndex2).Interior.ColorIndex
               jmfKolumner (Release)

               GoTo Omstart

           ElseIf i = 4 Then

               Release = wsTemp2.Range("E" & rwIndex2).Value
               ColorCell = wsTemp2.Range("E" & rwIndex2).Interior.ColorIndex
               jmfKolumner (Release)

               GoTo Omstart

           ElseIf i = 5 Then

               Release = wsTemp2.Range("F" & rwIndex2).Value
               ColorCell = wsTemp2.Range("F" & rwIndex2).Interior.ColorIndex
               jmfKolumner (Release)

               'Sluta leta i wsTemp2
               GoTo Avsluta

           End If

       End If

   rwIndex2 = rwIndex2 + 1
   Loop

Avsluta:
rwIndex1 = rwIndex1 + 1
Loop

End Sub

 

Sub jmfKolumner(Release As String, ColorCell As Integer)

'Bladet som informationen förs över till
Set wsTemp1 = Blad2

rwIndex = 1
colIndex1 = 2

'LOOP1 i wsTemp1
Do While wsTemp1.Cells(rwIndex, colIndex1).Value <> ""

   'Läser in värden
   Value1 = wsTemp1.Cells(rwIndex, colIndex1).Value

       If Value1 = Release Then
           If i = 1 Then
               wsTemp1.Cells(rwIndex1, colIndex1).Value = "Släpp1"
               'wsTemp1.Cells(rwIndex1, colIndex1).Interior.ColorIndex = ColorCell
           ElseIf i = 2 Then
               wsTemp1.Cells(rwIndex1, colIndex1).Value = "Släpp2"
               'wsTemp1.Cells(rwIndex1, colIndex1).Interior.ColorIndex = ColorCell
           ElseIf i = 3 Then
               wsTemp1.Cells(rwIndex1, colIndex1).Value = "Släpp3"
               'wsTemp1.Cells(rwIndex1, colIndex1).Interior.ColorIndex = ColorCell
           ElseIf i = 4 Then
               wsTemp1.Cells(rwIndex1, colIndex1).Value = "Släpp4"
               'wsTemp1.Cells(rwIndex1, colIndex1).Interior.ColorIndex = ColorCell
           ElseIf i = 5 Then
               wsTemp1.Cells(rwIndex1, colIndex1).Value = "Släpp5"
               'wsTemp1.Cells(rwIndex1, colIndex1).Interior.ColorIndex = ColorCell
           End If
           i = i + 1

           'Sluta leta i kolumnerna
           GoTo Avsluta2
       End If

colIndex1 = colIndex1 + 1
Loop

Avsluta2:
End Sub

 

Länk till kommentar
Dela på andra webbplatser

GOTO-satser är av ONDO. Bort med dem. Bort bort bort! Finns aldrig något behov av dem. Okej, ett tillfälle i VBA använder man dem, i felhantering. Alla andra fall går att lösa, och bör lösas, på annat sätt. Goto-satser ger bara oläslig kod.

 

Men till ditt problem, ska se om jag hittar något...

 

ahh, det klassiska...

 

Anrop till sub-rutiner kan man skriva antingen som

jmfKolumner Release, ColorCell

 

eller

Call jmfKolumner (Release, ColorCell)

 

dvs bort med parenteserna.

Senare i koden gör anrop till samma (?) funktion fast då med en variabel bara?

 

Samt ett sista tips, kod som ser snarlik ut går ofta att generalisera och då stoppa in i en egen rutin som anropar med det som skiljer. Finns en del upprepningar i din kod som kanske inte behöver finnas egentligen.

 

 

/T

 

Even when we know we´ll never find the answers, we have to keep on asking questions.

 

 

[inlägget ändrat 2008-12-17 14:11:54 av Monshi]

 

[inlägget ändrat 2008-12-17 14:35:23 av Monshi]

Länk till kommentar
Dela på andra webbplatser

Tack för hjälpen, nu funkar det. Jag vet att koden inte är den snyggaste. En kompis vill ha en snabb lösningen och det fick han.

 

/Peter

 

Länk till kommentar
Dela på andra webbplatser

Arkiverat

Det här ämnet är nu arkiverat och är stängt för ytterligare svar.

×
×
  • Skapa nytt...