Celwaarde negatief maken met filter aan

[bnavest]

Hallo,

Ik maak gebruik van Excel 2003 en heb een bestand waarin ik elk half jaar de afschriften van de bank importeer. Ik heb daarbij C (credit) en D (debit) regels.

D zijn afschrijvingen maar deze zijn niet negatief genoteerd. Ik wil deze negatief maken.

Wat ik doe is: filteren op D (zodat ik alleen de afschrijvingen zie) Kolom invoegen en in de eerste cel van de nieuwe kolom tik ik = (C2*-1) en deze formule kopieer ik door naar beneden.

Tot zover werkt het prima, alle waardes zijn negatief geworden vervolgens kopieer ik ze en plak ze speciaal (waarden en getal notaties) in de cellen van de bestaande kolom. Werkt ook nog prima.

Nu zet ik het filter weer uit, zodat ik de C (Crebit) regels ook weer zie en vervolgens blijkt dat de bedragen verschoven zijn en er dus niets meer van klopt.

Is er een andere manier om de celwaarde negatief te maken?

 

[robdgr]

Zonder filter: Naast C een kolom invoegen. Daarin

=ALS(B2="d";-C2;C2)

Naar beneden doortrekken en vervolgens kolommen B en C verbergen.

Klopt het dat dit ING is? Daarvoor gebruik ik de volgende code, gekoppeld aan een knop:

Sub Pb_in_kolommen_scheiden()
'
' Pb_in_kolommen_scheiden Macro
'

'
Application.ScreenUpdating = False
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True
    Cells.Select
    With Selection.Font
        .Name = "Verdana"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.ColumnWidth = 16.75
    Range("A1").Select
    Columns("A:A").ColumnWidth = 8.38
    Columns("A:A").ColumnWidth = 10.25
    Columns("B:B").ColumnWidth = 27.38
    Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    Columns("G:G").Select
    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=""bij"",RC[-1],-RC[-1])"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-1]),"""",IF(RC[-2]=""bij"",RC[-1],-RC[-1]))"
    Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H102"), Type:=xlFillDefault
    Range("H2:H102").Select
    Columns("F:G").Select
    Selection.EntireColumn.Hidden = True
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight
    Range("A2:K50").Select
    Selection.Copy
Application.ScreenUpdating = True
End Sub

 

[bnavest]

Opgelost

Bedankt,

Dit is precies wat ik bedoelde!
Bij mij gaat het om de Rabobank, ik exporteer de gegevens van Rabo naar een txt bestand.
Aan de hand van een macro worden de gegevens geimporteerd en op de juiste plek gezet.

Bedankt voor je reactie!

 

[robdgr]

Bij mij gaat het om de Rabobank, ik exporteer de gegevens van Rabo naar een txt bestand.

Dat doe ik ook nog. Ik kopieer die gegevens naar een hulppagina en daarop laat ik onderstaande macro los:

Sub Rabobank()
'
' Rabobank Macro
'

Application.ScreenUpdating = False
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C1").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(ISBLANK(RC[-1]),"""",DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),RIGHT(RC[-1],2)))"
    Range("C1").Select
    Selection.NumberFormat = "dd/mm/yyyy"
    Selection.AutoFill Destination:=Range("C1:C45"), Type:=xlFillDefault
    Range("C1:C45").Select
    Columns("C:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Range("D1:D45").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("E1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-1]),"""",IF(RC[-2]=""D"",VALUE(RC[-1]),VALUE(-RC[-1])))"
    Range("E1").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Selection.AutoFill Destination:=Range("E1:E45"), Type:=xlFillDefault
    Range("E1:E45").Select
    Columns("E:E").EntireColumn.AutoFit
    Columns("E:E").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("C:D").Select
    Range("D1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("D1").Select
    Columns("D:D").EntireColumn.AutoFit
    Range("D1:D45").Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="0"
    Selection.FormatConditions(1).Font.ColorIndex = 2
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").EntireColumn.AutoFit
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 9.13
    Range("H1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[1]),"""",RC[1])&"" ""&IF(ISBLANK(RC[2]),"""",RC[2])&"" ""&IF(ISBLANK(RC[3]),"""",RC[3])&"" ""&IF(ISBLANK(RC[4]),"""",RC[4])"
    Range("H2").Select
    Columns("H:H").EntireColumn.AutoFit
    Range("H1").Select
    Selection.AutoFill Destination:=Range("H1:H46"), Type:=xlFillDefault
    Range("H1:H46").Select
    Columns("H:H").Select
    Range("H4").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-6
    Selection.Replace What:="   ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Select
    With Selection.Font
        .Name = "Verdana"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Columns("I:M").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
        Range("A1:H42").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Key2:=Range("B1") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
Application.ScreenUpdating = True
End Sub

 

[snb]

Maak van opneem-VBA echte VBA.
dat kan bijv. simpeler:

Sub Rabobank()
  Application.ScreenUpdating = False
    with Columns(1)
      .TextToColumns  Comma:=True
      .AutoFit
    End with 
    columns(2).NumberFormat = "dd-mm-yyyy"
    for j=1 to 45
      cells(j,2)=datevalue(cells(j,2))
      cells(j,5)=iif(cells(j,3)="D","-","")&cells(j,3)
    Next
    Range("D1: D45").Replace ".", ","
    Range("E1:E45").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    With usedrange.columns("D:E")
        .FormatConditions.Add xlCellValue, xlEqual, "0"
        .FormatConditions(1).Font.ColorIndex = 2
        .ColumnWidth = 9.13
    End With
   ------
  Application.ScreenUpdating = True
End Sub

 

[robdgr]

Maak van opneem-VBA echte VBA.

snb,

Ik wou dat ik het kon, maar verzuip er nog steeds in. Mijn opname-vba werkt, maar is soms traag. Bijgaand het tekstbestandje dat omgezet moet worden. Bij jouw code krijg ik een foutmelding.

 

[snb]

Sub mutatie()
    Open "E:\OF\0_mut.txt" For Input As #1
        sq = Filter(Split(Replace(Input(LOF(1) - 1, #1), Chr(34), ""), vbCrLf), ",")
    Close #1
    For j = 0 To UBound(sq)
        sn = Split(sq(j), ",")
        If sn(3) = "D" Then sn(4) = "- " & sn(4)
        sq(j) = Join(sn, ",")
    Next
    With Sheets(1)
        .Cells(1, 1).Resize(UBound(sq) + 1) = WorksheetFunction.Transpose(sq)
        .Columns(1).TextToColumns , 1, xlNone, False, False, False, True, False, False
        .UsedRange.Columns.AutoFit
    End With
End Sub

 

[robdgr]

snb,

Ziet er schitterend uit, maar ik mis nog wat:

• ik heb de recorder gebruikt om de data om te zetten, maar krijg dat niet ingekort.
• in bedragen stond een punt en ook die heb ik gewijzigd zodat het bedragen zijn. De celeigenschappen kan ik niet meer aanpassen.

Voor vandaag sluit ik de luiken. Prettig weekend.

 

[snb]

Sub mutatie()
    Open "E:\OF\0_mut.txt" For Input As #1
        sq = Filter(Split(Replace(Input(LOF(1) - 1, #1), Chr(34), ""), vbCrLf), ",")
    Close #1
    For j = 0 To UBound(sq)
        sn = Split(sq(j), ",")
        If sn(3) = "D" Then sn(4) = "- " & sn(4)
        sn(2) = Format(DateValue(Mid(sn(2), 5, 2) & "-" & Right(sn(2), 2) & "-" & Left(sn(2), 4)), "dd/mm/yyyy")
        sq(j) = Join(sn, ",")
    Next
    With Sheets(1)
        .Cells(1, 1).Resize(UBound(sq) + 1) = WorksheetFunction.Transpose(sq)
        .Columns(1).TextToColumns , 1, xlNone, False, False, False, True, False, False
        .Columns(5).Replace ".", ","
        .UsedRange.Columns.AutoFit
    End With
End Sub