Autom Spaltenerstellung aus Schlagwortserie

Forumthread: Autom Spaltenerstellung aus Schlagwortserie

franziska_85

Hallo zusammen,
ich habe folgendes Problem: ich habe ca. 500 Bilder, welche alle mit einer Vielzahl verschiedener IPTC Schlagworte aus einer Gesamtschlagwortmenge von ca. 150 Schlagworten belegt sind. In einem ersten Schritt habe ich diese Schlagworte in eine vorläufige Excel-Tabelle exportiert, die ihr unten vereinfacht sehen könnt, wenn ihr wollt, kann ich auch einen Ausschnitt aus dem Original hochladen. Alle Schlagworte sind hier mit einem Komma voneinander getrennt (es existieren alle Schlagworte nur einmal). Nun möchte ich in irgendeiner Weise erreichen, dass Excel für alle möglichen Schlagworte am besten automatisch eine einzelne Spalte eröffnet die entweder bestätigt oder nicht bestätigt werden kann und dann für jedes Bild (also jede Zeile), für welche das Schlagwort erwähnt ist, selbiges bestätigt. Alternativ liegen die Daten auch noch in den IPTC-Bilddaten vor, wenn jmd. dazu etwas besseres einfällt.
Um es mal etwas plastischer zu machen hier ein stark vereinfachtes Beispiel:
1. Spalte........2. Spalte
Bild_22...........Hase,Fuchs,Mord
Bild_11...........Hase,Igel,Kuss
Bildname...Hase...Fuchs...Mord...Igel...Kuss
Bild_22......ja.......ja........ja........nein...nein
Bild_11......ja.......nein.....nein.....ja......ja
Für Hilfestellungen wäre ich sehr dankbar!
Lg,
Franziska

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Autom Spaltenerstellung aus Schlagwortserie

07.12.2009 21:01:27

ransi

HAllo Franziska
Ich habe eine Idee wie man das umsetzen könnte, aber eine Beispieltabelle wäre dazu echt hilfreich.
ransi

AW: Autom Spaltenerstellung aus Schlagwortserie

07.12.2009 21:21:20

franziska_85

Hallo ransi,
vielen Dank für Deine Hilfe schonmal,
hier ist ein Auszug aus der Excel-Datei im .xls-Format, die Schlagworte mögen etwas seltsam aussehen, es hat aber alles seine Richtigkeit und ist, wie gesagt, stets mit einem Komma abgetrennt (es sind auch die einzigen Kommas im Dokument, wenn nötig könnte man also alle auch durch einen anderen Platzhalter ersetzen):
https://www.herber.de/bbs/user/66415.xls
Lg,
Franziska

AW: Autom Spaltenerstellung aus Schlagwortserie

07.12.2009 23:18:59

Josef

Hallo Franziska,
probier mal.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub keywords()
  Dim objSh As Worksheet, objShSrc As Worksheet
  Dim vntKeywords() As Variant, vntTmp As Variant
  Dim lngRow As Long, lngIndex As Long

  Redim vntKeywords(0)

  Set objShSrc = Sheets("Tabelle1")

  With objShSrc
    For lngRow = 2 To Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
      vntTmp = Split(.Cells(lngRow, 2), ",")
      For lngIndex = 0 To UBound(vntTmp)
        If IsError(Application.Match(vntTmp(lngIndex), vntKeywords, 0)) Then
          vntKeywords(UBound(vntKeywords)) = vntTmp(lngIndex)
          Redim Preserve vntKeywords(UBound(vntKeywords) + 1)
        End If
      Next
    Next
  End With

  Redim Preserve vntKeywords(UBound(vntKeywords) - 1)

  If UBound(vntKeywords) > 0 Then
    If SheetExist("Keywords") Then
      Set objSh = Sheets("Keywords")
      objSh.Cells.Clear
      objSh.Activate
    Else
      Set objSh = ThisWorkbook.Worksheets.Add(After:=objShSrc)
      objSh.Name = "Keywords"
    End If
    With objSh
      .Columns(1) = objShSrc.Columns(1).Value
      With .Cells(1, 2).Resize(, UBound(vntKeywords) + 1)
        .Value = Application.Transpose(Application.Transpose(vntKeywords))
        .Orientation = 90
        .EntireColumn.AutoFit
        .EntireColumn.HorizontalAlignment = xlCenter
      End With
      For lngRow = 2 To Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
        vntTmp = Split(objShSrc.Cells(lngRow, 2), ",")
        For lngIndex = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
          If IsNumeric(Application.Match(.Cells(1, lngIndex), vntTmp, 0)) Then
            .Cells(lngRow, lngIndex) = "x"
          End If
        Next
      Next
    End With
  End If

  Set objSh = Nothing
  Set objShSrc = Nothing
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If wks.Name = sheetName Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function

Gruß Sepp

AW: Autom Spaltenerstellung aus Schlagwortserie

08.12.2009 00:51:12

franziska_85

Hallo Sepp,
vielen Dank für die Hilfe, habe mittlerweile auch anderweitig Hilde bekommen, werde das aber auf jeden Fall auch noch ausprobieren, vll. ist es ja noch eleganter,
klasse dass einem so schnell geholfen wird,
liebe Grüße,
Franziska

Crossposting oT

08.12.2009 10:54:31

Willy

Beliebteste Forumthreads (12 Monate)

Autom Spaltenerstellung aus Schlagwortserie

Forumthread: Autom Spaltenerstellung aus Schlagwortserie

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Autom Spaltenerstellung aus Schlagwortserie

Forumthread: Autom Spaltenerstellung aus Schlagwortserie

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread