Uitzonderingen maken in vba code

[scartsjer]

ik heb via via de volgende code gevonden.

Deze code haalt alle waarden uit het cell bereik E27:N300 en plakt deze onder elkaar in momenteel kolom Q.

deze doet nagenoeg precies wat ik wil echter wil ik dat lege cellen en cellen met een "x" worden overgeslagen.

hoe krijg ik dit bij onderstaande code in?

Sub Onderelkaar()
    Dim str1 As String, x As Integer, Mat1 As Variant
    With Sheets("Template")
        For x = 5 To 15    'aantal kolommen
            str1 = str1 & Application.WorksheetFunction.Trim(Join(Application.Transpose(.Range(.Cells(26, x), _
                .Cells(.Cells(Rows.Count, x).End(xlUp).Row, x))), " ")) & " "
        Next x
        Mat1 = Application.Transpose(Split(str1, " "))
        .Cells(1, 17).Resize(UBound(Mat1)) = Mat1
    End With
End Sub

dus de gewenste eindsituatie is een opsomming van alle waarden in E27:N300 onderelkaar geplakt in kolom Q met uitzondering van lege cellen en cellen met een X er in

 

[snb]

Vertel eerst svp eens wat de beginsituatie is en wat de eindsituatie moet worden.

 

[scartsjer]

Vertel eerst svp eens wat de beginsituatie is en wat de eindsituatie moet worden.

Excuus, aangepast.

 

[snb]

Sub M_snb()
 sn=[E27:N300].specialcells(2)

 for each it in sn
   if it<>"x" then c00=c00 & "|" & it
 next

 sn=split(mid(c00,2),"|")
 cells(1,17).resize(ubound(sn)+1)=application.transpose(sn)
End Sub

 

[scartsjer]

Hallo Snb,

ik heb van alles geprobeerd, maar de code die jij gaf stopt na de eerste x of lege cel. terwijl ik t hele vlak E27:N300 wil doorlopen.

in het bijgevoegde bestand gaat het om Module 5

 

[snb]

Je moet niet uitproberen, maar uitzoeken.
Lees eens wat meer over specialcells in de hulpbestanden van de VBEditor of elders.

 

[scartsjer]

snb, je hebt gelijk ... harder proberen werkt altijd.

Iets verder gezocht op de specialcells en ik kwam uiteindelijk uit bij een code die met een klein beetje hulp correct en efficiënter functioneerde.

Sub test2()

Dim vArray As Variant
Dim i As Long, j As Long, k As Long
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")

vArray = Range("E27:N300").Value

For i = 1 To UBound(vArray, 1)
    For j = 1 To UBound(vArray, 2)
        If Len(vArray(i, j)) <> 0 And vArray(i, j) <> "x" Then
            dict.Add k, vArray(i, j)
            k = k + 1
        End If
    Next
Next

Range("T1").Resize(dict.Count).Value = _
Application.Transpose(dict.items)

End Sub

 

[snb]

Ik ben het niet met je eens:

Sub M_snb()
  For Each it In Range("E27:N300").SpecialCells(2)
    If it <> "x" Then c00 = c00 & "|" & it
  Next
  
  sn = Split(Mid(c00, 2), "|")
  Cells(1, 17).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

of

Sub M_snb()
 For Each it In ActiveSheet.Hyperlinks
   c00 = c00 & "|" & it.TextToDisplay
 Next

 sn = Split(Mid(c00, 2), "|")
 Cells(1, 17).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

Begrijp je nu dan iets meer van specialcells ?