Θέμα: VBA If, move and concatenate

Εμφάνιση ενός μόνο μηνύματος
  #1  
Παλιά 04-07-11, 06:24
devcon Ο χρήστης devcon δεν είναι συνδεδεμένος
Όνομα: Θανάσης
Έκδοση λογισμικού Office: Ms-Office 2013
Γλώσσα λογισμικού Office: Αγγλική
 
Εγγραφή: 13-02-2010
Μηνύματα: 62
Προεπιλογή If, move and concatenate

Καλημέρα και καλή εβδομάδα,

Θα ήθελα την βοήθεια σας.
Επισυνάπτω δείγμα Excel.
Θέλω να συνενώσω (concatenate) τα δεδομένα της στήλης Β στην B εάν η στήλη Α είναι κενή και δεν υπάρχει η λέξη “offer”, “Offer”, “OFFER” .
Στην περίπτωση που υπάρχει η λέξη “offer”, “Offer”, “OFFER” να μετακινηθούν (move) τα κελία από την Β στην Γ.
Χρησιμοποιώ την ακόλουθη macro αλλά δυστυχώς δεν είναι αρκετή και δεν εκπληρώνει όλα αυτά που ζητώ.

Κώδικας:
Sub MoveValues()

Dim thing As Range
Dim lastARow As Integer

'Determine last Cell In Column B
 lastARow = Range("B" & Rows.Count).End(xlUp).Row

'Loop through Column B
  For Each thing In Sheets(1).Range("B2:B" & lastARow)

'Look for OFFER and Offer
   If thing.Value Like "*OFFER*" Or _
      thing.Value Like "*Offer*" Then
      
'If not found, Move B to C then Clear B
    Cells(thing.Row, 3) = Cells(thing.Row, 2)
    Cells(thing.Row, 2) = ""
       
   Else
'If found, Do Nothing
      GoTo LeaveItAlone
   End If
LeaveItAlone:
 Next
  
'If empty
 ActiveCell.FormulaR1C1 = _
        "=IF(R[1]C[-6]="""", CONCATENATE(RC[-5], "" "", R[1]C[-5], "" "", R[2]C[-5]), INDIRECT(""B""&ROW()))"
    Range("G3").Select

End Sub
Ο τρόπος που εκθέτω το πρόβλημα μου να μην είναι ξεκάθαρος αλλά πολλές φορές ένα δείγμα όπως το συνημμένο θεωρώ ότι είναι καλύτερο από χίλιες λέξεις.

Σας ευχαριστώ εκ των προτέρων για την βοήθεια σας.
Συνημμένα Αρχεία
Τύπος Αρχείου: xls Example.xls (30,0 KB, 15 εμφανίσεις)

Τελευταία επεξεργασία από το χρήστη Tasos : 04-07-11 στις 11:40. Αιτία: Αφαίρεση της πρ'ωτης γραμμής ([ATTACH]1752[/ATTACH] )
Απάντηση με παράθεση