Søg
Avatar billede kaz9k Juniormester
02. februar 2016 - 10:39 Der er 3 kommentarer og
1 løsning

Makro specifikation

Er der nogen, der kan hjælpe med at lave en lille makro, som kan specificere ud fra nogle indtastninger?

Jeg har nogle rækker, hvori der indtastes posteringsnr., beskrivelse, beløb, konto (kredit) og konto (debet).

Jeg vil gerne have Excel til at lave en specifikation af alle rækker, som indeholder et valgt kontonummer (f.eks. konto 1000).

Normalt ville man jo bare indsætte en autofilter, men problemer her, er at kontonummer (eks. 1000) kan stå både i konto (kredit) og konto (debet).

Måske skal der laves en makro, som aktiveres ved at angive det kontonummer, man ønsker specificeret...

Se regnearket her: http://play48.com/gratisupload/userprofiles/R78ggIhGlE/Specifikation%20af%20konto%5F1%2Exlsx

Tak
Avatar billede supertekst Ekspert
02. februar 2016 - 12:17 #1
VBA-koden ser således ud - hvis du sender en mail kan jeg returnere hele filen. @-adresse under min profil.

Option Explicit
Dim konto As Integer, post As Integer, beskrivelse As String
Dim antalRækker As Integer, beløb As Double, sum As Double, ræk As Integer

Dim specRæk As Integer
Sub specifikationPostering()
    konto = Range("B1")
   
    Sheets("Posteringer").Activate
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    sum = 0
    specRæk = 3
   
   
    For ræk = 3 To antalRækker
        beløb = 0
       
        With ActiveSheet
            If .Range("A" & ræk) <> "" Then
                If .Range("D" & ræk) = konto Then
                    beløb = .Range("C" & ræk) * -1
                Else
                    If .Range("E" & ræk) = konto Then
                        beløb = .Range("C" & ræk)
                    End If
                End If
            End If
       
            If beløb <> 0 Then
                post = .Range("A" & ræk)
                beskrivelse = .Range("B" & ræk)
                sum = sum + beløb
       
                Sheets("Specifikation").Activate
               
                With ActiveSheet
                    .Range("A" & specRæk) = post
                    .Range("B" & specRæk) = beskrivelse
                    .Range("C" & specRæk) = beløb
                End With
                specRæk = specRæk + 1
            End If
        End With
        Sheets("Posteringer").Activate
    Next ræk
   
    Sheets("Specifikation").Activate
    ActiveSheet.Range("C" & specRæk) = sum
    ActiveCell.Font.Bold = True
    Columns.AutoFit
   
    Range("B1").Select
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim antalRæk As Integer
    If IsNumeric(Range("B1")) = True And Range("B1") <> "" Then
        antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
        Range("A3:C" & antalRæk).Select
        Selection.ClearContents
       
        specifikationPostering
    End If
End Sub
Avatar billede supertekst Ekspert
02. februar 2016 - 13:53 #2
Option Explicit

Rem Version 2

Dim konto As Integer, post As Integer, beskrivelse As String
Dim antalRækker As Integer, beløb As Double, sum As Double, ræk As Integer

Dim specRæk As Integer
Sub specifikationPostering()
    konto = Range("B1")
   
    Application.ScreenUpdating = False
    Sheets("Posteringer").Activate
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    sum = 0
    specRæk = 3
   
   
    For ræk = 3 To antalRækker
        beløb = 0
       
        With ActiveSheet
            If .Range("A" & ræk) <> "" Then
                If .Range("D" & ræk) = konto Then
                    beløb = .Range("C" & ræk) * -1
                Else
                    If .Range("E" & ræk) = konto Then
                        beløb = .Range("C" & ræk)
                    End If
                End If
            End If
       
            If beløb <> 0 Then
                post = .Range("A" & ræk)
                beskrivelse = .Range("B" & ræk)
                sum = sum + beløb
       
                Sheets("Specifikation").Activate
               
                With ActiveSheet
                    .Range("A" & specRæk) = post
                    .Range("B" & specRæk) = beskrivelse
                    .Range("C" & specRæk) = beløb
                End With
                specRæk = specRæk + 1
            End If
        End With
        Sheets("Posteringer").Activate
    Next ræk
   
    Sheets("Specifikation").Activate
    ActiveSheet.Range("C" & specRæk).Select
    Selection = sum
    Selection.Font.Bold = True
    Columns.AutoFit
   
    Range("B1").Select
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim antalRæk As Integer
    If IsNumeric(Range("B1")) = True And Range("B1") <> "" Then
        antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
        Range("A3:C" & antalRæk).Select
        Selection.Delete
       
        specifikationPostering
    End If
End Sub
Avatar billede finb Ekspert
02. februar 2016 - 14:00 #3
=hvis(er.tal(find("1000";sammenkædning(aktuelleKolonner));såEtEllerAndet;Ellers))
Avatar billede ebea Ekspert
02. februar 2016 - 19:07 #4
En løsning mere, med et ekstra ark, hvor du kan angive det ønskede konto nummer i en celle, og få returneret tallene for den angivne konto!
Forklaring er vist i eksemplet!


https://www.dropbox.com/s/uq338lrqex26ofc/Specifikation%20af%20konto_1.xlsx?dl=0
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
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Hvordan bruges indeks & sammenlign når der skal søges over flere kolonner? Af Laugesen1 i Excel 4 08/03/202611:56 08/03/202613:57
Tips til at mestre Excel hurtigt Af MonikaG32 i Excel 4 04/03/202617:11 06/03/202609:37
Båndet i Excel online har ændret størrelse Af Monique i Excel 3 19/02/202614:23 20/02/202608:26
Fjern tekst efter mellemrum Af ABE15 i Excel 2 18/02/202620:41 19/02/202611:30
Udskrift af ark Af boro23 i Excel 4 17/02/202608:38 18/02/202607:46
Se alle spørgsmål i kategorien Opret spørgsmål

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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I går 16:12 Outlook fejler: 0x80070057 + 0x800CCC0E Af TTA i Office & Kontorpakker
14/0320:13 PIHOLE Af dcedata1977 i Linux
13/0312:06 SDKORT / SSD Af dcedata1977 i Linux
13/0309:12 Kan min telefon høre en samtale og lave annonce tilbud efter det Af Niels Ebbe Schmidt Huus i Mobiltelefoner
11/0307:12 Fastnettelefon Af nu_igen i Andet hardware
White papers
Flere white papers »