識別它，然後將它（微距）

我有這個項目中化學供應現在我已經找到了一個網站，它給了我一個很長的列表元素複合元素的列表：識別它，然後將它（微距）

this will be the references

我已經做了這個代碼，但它不起作用

Sub move() 
    Dim list As Range 
    Set list = Range("A1:A2651") 

    For Each Row In list.Rows 
      If (Row.Font.Regular) Then 
       Row.Cells(1).Offset(-2, 1) = Row.Cells(1) 
      End If 
    Next Row 
End Sub

你可以讓它運行嗎？你可以有你自己的算法。

來源

2016-09-22 Grover Reyes

請分享網站的網址。描述什麼意思是「它不起作用」？ – omegastripes

https://quizlet.com/18087424/a-long-long-list-of-chemical-compounds-and-their-names-flash-cards/ –

假設名單是不斷地在相同的格式（即化合物名稱，空行，複合符號，空行）這個簡單的代碼將工作：

Sub move() 
Dim x As Integer 
    x = 3 
With ActiveSheet 
    Do Until x > 2651 
     .Cells(x - 2, 2).Value = .Cells(x, 1).Value 
     .Cells(x, 1).ClearContents 
     x = x + 4 
    Loop 
End With 
End Sub

運行然後你可以只排序列後： B刪除空白。

嘗試你的原始代碼後，我意識到問題是與.regular屬性值。我之前沒有看到過，因此將其替換爲NOT .bold，並忽略空白條目，然後添加行以清除複製單元格的內容。這是最像原來的代碼以供參考：

Sub get_a_move_on() 
    Dim list As Range 
    Set list = ActiveSheet.Range("A1:A2561") 

    For Each Row In list.Rows 
      If Row.Font.Bold = False And Row.Value <> "" Then 
       Row.Cells(1).Offset(-2, 1) = Row.Cells(1) 
       Row.Cells(1).ClearContents 
      End If 
    Next Row 
End Sub

P.S它是化合物的列表，而不是元素，還有在週期表中只有約120元！ ;）

來源

2016-09-22 05:54:11 jamheadart

完美。像魅力一樣工作 –

沒有probs！你原來的代碼很酷，實際上除了.regular部分外幾乎是完全的聲音，所以我更新了我的答案，以顯示你的代碼的一個稍微修改過的版本，我剛學到了一些東西：D – jamheadart

另一種方法來檢索您通過XHR和正則表達式需要的數據：

Sub GetChemicalCompoundsNames() 

    Dim sRespText As String 
    Dim aResult() As String 
    Dim i As Long 

    ' retrieve HTML content 
    With CreateObject("MSXML2.XMLHTTP") 
     .Open "GET", "https://quizlet.com/18087424", False 
     .Send 
     sRespText = .responseText 
    End With 
    ' regular expression for rows 
    With CreateObject("VBScript.RegExp") 
     .Global = True 
     .MultiLine = True 
     .IgnoreCase = True 
     .Pattern = "qWord[^>]*?>([\s\S]*?)<[\s\S]*?qDef[^>]*?>([\s\S]*?)<" 
     With .Execute(sRespText) 
      ReDim aResult(1 To .Count, 1 To 2) 
      For i = 1 To .Count 
       With .Item(i - 1) 
        aResult(i, 1) = .SubMatches(0) 
        aResult(i, 2) = .SubMatches(1) 
       End With 
      Next 
     End With 
    End With 
    ' output to the 1st sheet 
    With Sheets(1) 
     .Cells.Delete 
     Output .Range("A1"), aResult 
    End With 

End Sub 

Sub Output(oDstRng As Range, aCells As Variant) 
    With oDstRng 
     .Parent.Select 
     With .Resize(_ 
      UBound(aCells, 1) - LBound(aCells, 1) + 1, _ 
      UBound(aCells, 2) - LBound(aCells, 2) + 1 _ 
     ) 
      .NumberFormat = "@" 
      .Value = aCells 
      .Columns.AutoFit 
     End With 
    End With 
End Sub

給出輸出（663行總數）：

來源

2016-09-22 13:52:18 omegastripes

識別它，然後將它（微距）

回答

相關問題