Microsoft Excel

Herbers Excel/VBA-Archiv

Autom Spaltenerstellung aus Schlagwortserie | Herbers Excel-Forum


Betrifft: Autom Spaltenerstellung aus Schlagwortserie von: franziska_85
Geschrieben am: 07.12.2009 20:41:09

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

  

Betrifft: AW: Autom Spaltenerstellung aus Schlagwortserie von: ransi
Geschrieben am: 07.12.2009 21:01:27

HAllo Franziska

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

ransi


  

Betrifft: AW: Autom Spaltenerstellung aus Schlagwortserie von: franziska_85
Geschrieben am: 07.12.2009 21:21:20

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


  

Betrifft: AW: Autom Spaltenerstellung aus Schlagwortserie von: Josef Ehrensberger
Geschrieben am: 07.12.2009 23:18:59

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



  

Betrifft: AW: Autom Spaltenerstellung aus Schlagwortserie von: franziska_85
Geschrieben am: 08.12.2009 00:51:12

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


  

Betrifft: Crossposting oT von: Willy
Geschrieben am: 08.12.2009 10:54:31