Category Archives: Windows

Für eine Liste von 150 selbst vergegebenen EAN-Nummern (12 Ziffern) sollte die Prüfziffer (13. Ziffer) berechnet werden, um eine EAN13 / GTIN-13 zu erhalten. Um nicht jeden Barcode einzeln bei GS1 zu copy & pasten, habe ich nach einer Excel Formel gesucht.

In meinem Beispiel steht die 12-stellige EAN-Nummer in A2 (entsprechend in der Formel auf eure Zelle anpassen) und den folgenden Code füge ich in B2 ein:

=REST(MMULT(-TEIL(A2;SPALTE(A:L);1);3^REST(ZEILE($2:$13);2));10)

Excel Formel zur EAN14 / GTIN-14 Prüfziffernberechnung:

=LET(x;TEXT(A2;"0000000000000");REST(10-REST(SUMMENPRODUKT(--TEIL(x;SEQUENZ(13);1);WENN(ISTGERADE(SEQUENZ(13));1;3));10);10))

Excel Formel zur EAN8 / GTIN-8 Prüfziffernberechnung:

=REST(10-REST(SUMMENPRODUKT((0&TEIL($A2;{1.3.5.7};1))*1)*3+SUMMENPRODUKT((0&TEIL($A2;{2.4.6};1))*1);10);10)

Um die EAN-Nummer und die soeben errechnete Prüfziffer zusammen zu setzen, benutze ich VERKETTEN in Zelle C2:

=VERKETTEN(B2;C2)

Für weitere EAN-Nummern die Formeln einfach nach unten ziehen oder Doppelklick auf die Ecke unten rechts.

Tipp: Wenn Excel die EAN-Codes nicht richtig anzeigt: Spalte als Zahl mit 0 Dezimalstellen formatieren.

Alternativ kann man in den Excel Optionen die automatische Konvertierung der EAN-Codes und das entfernen führender Nullen (z.B. bei Artikelnummern oder Postleitzahlen) deaktieren:
Datei -> Optionen -> Daten und die Haken raus nehmen:

Neues Makro zur Excel Tabelle hinzufügen, folgendes Makro einfügen (ggf. Dateipfad anpassen), Makro starten und warten bis es abgeschlossen ist:

Option Explicit
Sub ImportCSVFiles()

    Dim strFolderName As String, _
        strFileName As String
    Dim wbkThisWbk As Workbook, _
        wbkMyCSVFile As Workbook
    Dim shtMyTab As Worksheet
    Dim lngMyRow As Long, _
        lngMyCol As Long, _
        lngPasteRow As Long
    Dim strMyCol As String
    Dim blnIncludeHeader As Boolean
    Dim xlnCalcMethod As XlCalculation

    Set wbkThisWbk = ThisWorkbook
    Set shtMyTab = ActiveSheet 'Imports the data into the activesheet. Change to suit i.e. to import into Sheet1 use this: Set shtMyTab = Sheets("Sheet1")
    blnIncludeHeader = True

    With Application
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .StatusBar = "Please wait while the files are imported..."
    End With

    'Initialise the following varibales to the first *.csv file in the designated folder
    strFolderName = "C:\CSVImportTest\" 'Folder name containing the files. Change to suit, but don't forget the trailing backslash!!
    strFileName = Dir(strFolderName & "*.csv") 'File types to import

    Do Until strFileName = ""

        Set wbkMyCSVFile = Workbooks.Open(strFolderName & strFileName)

        'As a comma separated value file can only have one tab, it's OK to simply use the first sheet via index 1
        With wbkMyCSVFile.Sheets(1)

            If WorksheetFunction.CountA(.Cells) > 0 Then

                lngMyRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                lngMyCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
                strMyCol = Left(Cells(1, lngMyCol).Address(True, False), Application.WorksheetFunction.Search("$", Cells(1, lngMyCol).Address(True, False)) - 1)

                If blnIncludeHeader = True Then
                    .Range("A1:" & strMyCol & lngMyRow).Copy
                Else
                    .Range("A2:" & strMyCol & lngMyRow).Copy
                End If

                Workbooks(wbkThisWbk.Name).Activate
                Sheets(shtMyTab.Name).Select

                If blnIncludeHeader = True Then
                    Range("A1").PasteSpecial xlPasteValues
                Else
                    lngPasteRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Range("A" & lngPasteRow).PasteSpecial xlPasteValues
                End If

            End If

        End With

        Application.DisplayAlerts = False
            wbkMyCSVFile.Close SaveChanges:=False
        Application.DisplayAlerts = True

        strFileName = Dir()

        blnIncludeHeader = False

    Loop

    With Application
        .Calculation = xlnCalcMethod
        .StatusBar = ""
        .ScreenUpdating = True
    End With

   MsgBox "Files have now been imported."

End Sub

Quelle: http://www.mrexcel.com/forum/excel-questions/674828-combine-100-excel-csv-files-one-sheet-each-into-one-sheet.html#post3342776