waarden in verschillende kolommen negatief maken

Status
Niet open voor verdere reacties.
D

dekrant

Gebruiker
Lid geworden
27 jun 2014
Berichten
20
Goedemiddag,

Ik heb een excel waarbij ik een aantal kolommen negatief wil maken.
Het excelbestand wordt bewerkt via vba. In eerste instantie heb ik de kolommen inderdaad negatief gekregen, maar dit was alleen de weergave. Excel rekende niet met het negatieve getal.
Dit heb ik gedaan met: Columns(item).NumberFormat = "-#,##0.00;-#,##0.00;0"

heeft iemand de oplossing voor mij?
Dit is mijn volledige macro.

Alvast bedankt
De krant



Sub M_snb()
Dim item As Integer, item2 As Integer, item3 As Integer
rownumber = 1
Dim rng As Range


rcount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count

Do
Range("b1").Offset(rownumber).Select
If ActiveCell = "" Then
ActiveCell.EntireRow.Delete
rcount = rcount - 1
Else
rownumber = rownumber + 1
End If

Loop Until rownumber = rcount


Set rng = ActiveSheet.Range("A1:bx1")
item = Application.WorksheetFunction.Match("erni", rng, 0) + 1
Cells(1, item).EntireColumn.Insert
Cells(1, item - 1).EntireColumn.Copy Destination:=Cells(1, item)
Cells(item) = "erNI Balans"
Cells(item).EntireColumn.Select

item2 = Application.WorksheetFunction.Match("standard life (Er)", rng, 0) + 1
Cells(1, item2).EntireColumn.Insert
Cells(1, item2 - 1).EntireColumn.Copy Destination:=Cells(1, item2)
Cells(item2) = "Standard life (Er) Balans"
Cells(item2).EntireColumn.Select

item3 = Application.WorksheetFunction.Match("Pension sacrifice (Er)", rng, 0) + 1
Cells(1, item3).EntireColumn.Insert
Cells(1, item3 - 1).EntireColumn.Copy Destination:=Cells(1, item3)
Cells(item3) = "Pension sacrifice(Er) Balans"
Cells(item3).EntireColumn.Select

item15 = Application.WorksheetFunction.Match("RSU compensation value", rng, 0) + 1
Cells(1, item15).EntireColumn.Insert
Cells(1, item15 - 1).EntireColumn.Copy Destination:=Cells(1, item15)
Cells(item15) = "RSU compensation"
Cells(item15).EntireColumn.Select

item4 = Application.WorksheetFunction.Match("Netpay", rng, 0)
item5 = Application.WorksheetFunction.Match("tax", rng, 0)
item6 = Application.WorksheetFunction.Match("standard life", rng, 0)
item7 = Application.WorksheetFunction.Match("NI", rng, 0)
item8 = Application.WorksheetFunction.Match("PPP", rng, 0)
item9 = Application.WorksheetFunction.Match("mileage deduction", rng, 0)
item10 = Application.WorksheetFunction.Match("studentloan", rng, 0)
item11 = Application.WorksheetFunction.Match("espp", rng, 0)
item12 = Application.WorksheetFunction.Match("car allowance net deducti", rng, 0)
item13 = Application.WorksheetFunction.Match("advance recovery", rng, 0)
item14 = Application.WorksheetFunction.Match("childcare vouchers", rng, 0)
item16 = Application.WorksheetFunction.Match("Pension sacrifice(Er) Balans", rng, 0)
item17 = Application.WorksheetFunction.Match("Standard life (Er) Balans", rng, 0)

Columns(item).NumberFormat = "-#,##0.00;-#,##0.00;0"
Columns(item2).NumberFormat = "-#,##0.00;-#,##0.00;0"
Columns(item4).NumberFormat = "-#,##0.00;-#,##0.00;0"

icol = Cells(1, Columns.Count).End(xlToLeft).Column
For x = icol To 1 Step -1
If Cells(1, x).Value = "RunDate" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "Forename" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "Surname" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "CostCentre" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "Status" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "TaxCode" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "NILetter" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "SSP" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "SMP" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "SAP" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "SPPA" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "SPPB" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "GUStudentLoan" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "GUNIReduction" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "TaxablePay" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "BIK" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "Dept" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "ESPP Percentage (%)" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "ESPP Percentage (Rate)" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "ESPP Percentage" Then Cells(1, x).EntireColumn.Delete
If Cells(1, x).Value = "AEO" Then Cells(1, x).EntireColumn.Delete
Next



sn = [origineel!A1].CurrentRegion
ReDim sp((UBound(sn) - 1) * (UBound(sn, 2) - 1), 2)

For j = 0 To UBound(sp) - 1
x = j \ (UBound(sn, 2) - 1) + 2
y = j Mod (UBound(sn, 2) - 1) + 2
sp(j, 0) = sn(x, 1)
sp(j, 1) = sn(1, y)
sp(j, 2) = sn(x, y)
Next

[bewerkt!A1].Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp

End Sub

[/SIZE][/FONT]
 
Doe de waarde van de cel * -1

Daarnaast doe je ons een plezier als je hier je code in codetags zet.
 
Goedemorgen Edmoor,

Dankje voor je reactie.
Ik had zelf ook bedacht om de waarde van de cel te vermenigvuldigen met -1, maar sorry dat ik het vraag, maar hoe doe ik dit in VBA?
Op het moment dat ik mijn macro in het bericht plak haalt hij alle opmaak weg, vandaar.

Groeten
De krant
 
Code tags kan je zo doen. Tik:
[ CODE]
Dan je code. gevolgd door
[ /CODE]

Maar dan zonder de spaties achter het [ teken.
 
Dankje,
En hoe doe ik het vermenigvuldigen?
Dit: Columns(item) * -1 werkt in ieder geval niet :(

Groeten
De krant
 
Je hebt je eerste bericht nog niet zodanig aangepast dat de code in de genoemde tags staat. Zelf vind ik dat erg lastig lezen omdat dan ook de inspringpunten niet aanwezig zijn. Maar probeer eens dit:
Columns(item).Value = Columns(item).Value * -1
 
Dankje voor de code tip, ik geloof dat het nu goed gaat. :)

helaas wordt er wel een foutmelding gegeven op
Columns(item).Value = Columns(item).Value * -1



Code: 
Sub M_snb()
Dim item As Integer, item2 As Integer, item3 As Integer
rownumber = 1
Dim rng As Range

  
rcount = ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
  
Do
     Range("b1").Offset(rownumber).Select
     If ActiveCell = "" Then
        ActiveCell.EntireRow.Delete
        rcount = rcount - 1
     Else
        rownumber = rownumber + 1
     End If
      
Loop Until rownumber = rcount

      
 Set rng = ActiveSheet.Range("A1:bx1")
       item = Application.WorksheetFunction.Match("erni", rng, 0) + 1
       Cells(1, item).EntireColumn.Insert
       Cells(1, item - 1).EntireColumn.Copy Destination:=Cells(1, item)
       Cells(item) = "erNI Balans"
       Cells(item).EntireColumn.Select
      
       item2 = Application.WorksheetFunction.Match("standard life (Er)", rng, 0) + 1
       Cells(1, item2).EntireColumn.Insert
       Cells(1, item2 - 1).EntireColumn.Copy Destination:=Cells(1, item2)
       Cells(item2) = "Standard life (Er) Balans"
       Cells(item2).EntireColumn.Select
       
       item3 = Application.WorksheetFunction.Match("Pension sacrifice (Er)", rng, 0) + 1
       Cells(1, item3).EntireColumn.Insert
       Cells(1, item3 - 1).EntireColumn.Copy Destination:=Cells(1, item3)
       Cells(item3) = "Pension sacrifice(Er) Balans"
       Cells(item3).EntireColumn.Select
       
       item15 = Application.WorksheetFunction.Match("RSU compensation value", rng, 0) + 1
       Cells(1, item15).EntireColumn.Insert
       Cells(1, item15 - 1).EntireColumn.Copy Destination:=Cells(1, item15)
       Cells(item15) = "RSU compensation"
       Cells(item15).EntireColumn.Select
       
       item4 = Application.WorksheetFunction.Match("Netpay", rng, 0)
       item5 = Application.WorksheetFunction.Match("tax", rng, 0)
       item6 = Application.WorksheetFunction.Match("standard life", rng, 0)
       item7 = Application.WorksheetFunction.Match("NI", rng, 0)
       item8 = Application.WorksheetFunction.Match("PPP", rng, 0)
       item9 = Application.WorksheetFunction.Match("mileage deduction", rng, 0)
       item10 = Application.WorksheetFunction.Match("studentloan", rng, 0)
       item11 = Application.WorksheetFunction.Match("espp", rng, 0)
       item12 = Application.WorksheetFunction.Match("car allowance net deducti", rng, 0)
       item13 = Application.WorksheetFunction.Match("advance recovery", rng, 0)
       item14 = Application.WorksheetFunction.Match("childcare vouchers", rng, 0)
       item16 = Application.WorksheetFunction.Match("Pension sacrifice(Er) Balans", rng, 0)
       item17 = Application.WorksheetFunction.Match("Standard life (Er) Balans", rng, 0)
       
       Columns(item).Value = Columns(item).Value * -1
       
icol = Cells(1, Columns.Count).End(xlToLeft).Column
For x = icol To 1 Step -1
    If Cells(1, x).Value = "RunDate" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "Forename" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "Surname" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "CostCentre" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "Status" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "TaxCode" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "NILetter" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "SSP" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "SMP" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "SAP" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "SPPA" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "SPPB" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "GUStudentLoan" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "GUNIReduction" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "TaxablePay" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "BIK" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "Dept" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "ESPP Percentage (%)" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "ESPP Percentage (Rate)" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "ESPP Percentage" Then Cells(1, x).EntireColumn.Delete
    If Cells(1, x).Value = "AEO" Then Cells(1, x).EntireColumn.Delete
Next
    
      
   
   sn = [origineel!A1].CurrentRegion
   ReDim sp((UBound(sn) - 1) * (UBound(sn, 2) - 1), 2)
   
   For j = 0 To UBound(sp) - 1
     x = j \ (UBound(sn, 2) - 1) + 2
     y = j Mod (UBound(sn, 2) - 1) + 2
     sp(j, 0) = sn(x, 1)
     sp(j, 1) = sn(1, y)
     sp(j, 2) = sn(x, y)
   Next
   
   [bewerkt!A1].Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
   
End Sub
 
Als je zegt een foutmelding te krijgen is het ook handig deze er even bij te vermelden.
 
Dit is de foutmelding:
Run-time error '13'

Type mismatch

Groeten
De krant
 
probeer het eens op deze manier

Code: 
For Each cl In Columns(Item).SpecialCells(2, 1)
    cl.Value = Abs(cl) * -1
Next cl
 
Jaaaa, het werkt. Dankje.
Ik heb hem zelf nog iets aangepast om het voor een aantal kolommen te doen.

Groeten
de krant



Code: 
Set myRange = Union(Columns(item), Columns(item4), Columns(item5), Columns(item6), Columns(item7), Columns(item8), Columns(item9), Columns(item10), Columns(item11), Columns(item12), Columns(item13), Columns(item14), Columns(item15), Columns(item16), Columns(item17), Columns(item18))
       
For Each cl In myRange.SpecialCells(2, 1)
    cl.Value = Abs(cl) * -1
Next cl
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan