返回列表 上一主題 發帖

中英字串只留中文

中英字串只留中文

本帖最後由 Scarlett 於 2021-5-28 22:26 編輯

請教如何把爬蟲下來的資料,刪除Range("B9:B85")中的英文,只留下中文?
擷取.PNG

test.rar (133.43 KB)

回復 1# Scarlett


看來有規則,請問使用資料剖析可以完成嗎?

TOP

回復 1# Scarlett

這是網路上找的ASC + MID 切割 方法 缺點是 很慢 因為是跑每一個字 看看有沒有大大願意幫忙 應該有其他方式 可以直接貼整個表格
test0529.rar (138.25 KB)

TOP

本帖最後由 quickfixer 於 2021-5-30 00:33 編輯

01學來的
從原始資料處理會比較快,不用1秒整頁全抓下來,33個表格,自己看要留什麼
變數stock    strYear    strSeason,自己換上
Sub test()
    Dim URL As String, HTMLsourcecode As Object, GetXml As Object
    Set HTMLsourcecode = CreateObject("htmlfile")
    Set GetXml = CreateObject("msxml2.xmlhttp")
    URL = "https://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=2012&SYEAR=2020&SSEASON=3&REPORT_ID=C"
    Cells.Clear
    Application.ScreenUpdating = False
    With GetXml
        .Open "GET", URL, False
        .send
        HTMLsourcecode.body.innerhtml = convertraw(.ResponseBody)
        For k = 0 To HTMLsourcecode.all.tags("table").Length - 1
            Set Table = HTMLsourcecode.all.tags("table")(k).Rows
            For i = 0 To Table.Length - 1
                lastrow = lastrow + 1
                For j = 0 To Table(i).Cells.Length - 1
                    If InStr(Table(i).Cells(j).innerhtml, "SPAN class=zh") > 0 Then
                    ActiveSheet.Cells(lastrow, j + 1) = Trim(Replace(Split(Table(i).Cells(j).innerhtml, "</SPAN>")(0), "<SPAN class=zh>", ""))
                    Else
                    ActiveSheet.Cells(lastrow, j + 1) = Trim(Table(i).Cells(j).innertext)
                    End If
                Next j
            Next i
        Next k
    End With
    Application.ScreenUpdating = False
    Set HTMLsourcecode = Nothing
    Set GetXml = Nothing
End Sub
Function convertraw(rawdata)
    Dim rawstr
    Set rawstr = CreateObject("adodb.stream")
    With rawstr
        .Type = 1
        .Mode = 3
        .Open
        .Write rawdata
        .Position = 0
        .Type = 2
        .Charset = "big5"
        convertraw = .ReadText
        .Close
    End With
    Set rawstr = Nothing
End Function

TOP

本帖最後由 Scarlett 於 2021-5-30 11:59 編輯

回復 4# quickfixer 謝謝大大,我是寫在End Sub之上。

TOP

本帖最後由 Scarlett 於 2021-5-30 12:00 編輯

回復 3# 軒云熊謝謝大大,這就我想要的格式,地確速度也是個問題。

TOP

Sub zz()
Dim a
a = Range("b9:b" & [b65536].End(3).Row).Value
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "[\!-~\s]*"
    For i = 1 To UBound(a)
        a(i, 1) = .Replace(a(i, 1), "")
    Next
    [b9].Resize(i - 1, 1) = a
End With
End Sub

TOP

本帖最後由 軒云熊 於 2021-5-31 03:37 編輯

回復 6# Scarlett

感謝 ikboy 前輩 的正則表達式 改了一下 速度快很多了  謝謝

test0531.rar (176.79 KB)

TOP

回復 6# Scarlett

抱歉沒注意到 這段改一下 感謝

    IE.Quit
'    Range("B10:B85").Delete
    [A7].Resize(i, j) = Brr
    Columns.AutoFit

TOP

        靜思自在 : 看別人不順眼,是自己修養不夠。
返回列表 上一主題