नमस्ते, मैं देख रहा हूं कि अपने कोड को कैसे संपादित किया जाए ताकि स्ट्रिंग की शुरुआत के फ़ॉन्ट रंग को लाल और बोल्ड करने के बजाय, यह इन स्ट्रिंग्स को किसी अन्य वर्कशीट में चिपका देता है, हालांकि जब भी मैं इसे संपादित करने का प्रयास करता हूं तो मैं हमेशा समाप्त होता हूं एक रन टाइम त्रुटि। किसी भी मदद की सराहना की जाएगी, मेरा वर्तमान कोड यहां है:

Sub colorText()

    Dim cl As Range
    Dim startPos As Integer
    Dim totalLen As Integer
    Dim searchText As String
    Dim endPos As Integer
    Dim testPos As Integer

     ' specify text to search.
     searchText = "(9)"

    ' loop trough all cells in selection/range
     For Each cl In Range("A:A")
      totalLen = Len(searchText)
      startPos = InStr(cl, searchText)
      testPos = 0

      Do While startPos > testPos
         With cl.Characters(startPos, totalLen).Font
          .FontStyle = "Bold"
          .ColorIndex = 3
         End With

    endPos = startPos + totalLen
    testPos = testPos + endPos
     startPos = InStr(testPos, cl, searchText, vbTextCompare)
  Loop

Next cl

End Sub
0
J. Thomas 14 नवम्बर 2017, 14:53

2 जवाब

सबसे बढ़िया उत्तर

तो आपने जो कहा है उसके अनुसार मुझे लगता है कि यह वही है जिसे आप ढूंढ रहे हैं? आपका वर्तमान कोड वास्तव में समझ में नहीं आता है यदि खोज के लिए स्ट्रिंग के भीतर SearchString की स्थिति प्रासंगिक नहीं है जैसा आपने कहा था।

Sub CopyMatchedValuesToSheet()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRowSource As Long, i As Long
Dim SearchString As String
Dim cell As Range

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

SearchString = "2" ' Set SearchString value or use the one below if you want to change it each time

'SearchString = Application.InputBox("Give a string", "SearchString", Type:=2)

i = 1

With ws1
    LastRowSource = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    
    For Each cell In .Range("A1:A" & LastRowSource) ' Change to A2 if it has header
        If InStr(cell.Value, SearchString) > 0 Then
            ws2.Cells(i + 1, 1).Value = cell.Value
            i = i + 1
        End If
    Next cell
End With

End Sub

हर बार कोड बदलने पर आप शीट2 को खाली करने के लिए निम्नलिखित का उपयोग कर सकते हैं:

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2") 
ws2.Cells.Clear
0
Mikael Kajander 15 नवम्बर 2017, 09:13

अगर मैंने आपकी समस्या को सही ढंग से और समझ लिया है, तो आपको केवल उस स्ट्रिंग का निर्माण करना है जिसे आप कॉपी करना चाहते हैं, और इसे उस सेल को असाइन करें जिसे आप चाहते हैं:

Dim temp as String
If Not startPos = 0 Then
    temp = Mid(cl, startPos)   
    Sheets("sheet2").Cells(cl.Row, cl.Column) = temp
End If
0
Amine Teffal 14 नवम्बर 2017, 19:16