Học tiếng Nhật: tải bài từ web, sắp xếp, phát âm, dịch nghĩa

Hoàng Nhật Phương · 10/12/20

Xin chào các bạn,
OT copy một vùng dữ liệu từ Website về để vào trong cột B từ cột B này OT muốn chuyển dữ liệu sang thành dòng (như hình ảnh đính kèm bên dưới:

Nhờ các bạn xem và giúp đỡ OT ạ.

befaint · 10/12/20

Sao mình không đưa link website ấy.

Hoàng Nhật Phương · 10/12/20

befaint đã viết:
Sao mình không đưa link website ấy.

Xin chào , befaint cảm ơn Bạn đã quan tâm và giúp đỡ OT.
"mình" xin được gửi link ạ: :"'

Bài 12: Từ vựng trong Minnano Nihongo | Tổng hợp 50 bài Minna No Nihongo

Minna No Nihongo là cuốn sách được đông đảo người học tiếng Nhật lựa chọn khi mới bắt đầu. Cuốn sách bao gồm nhiều phiên bản hỗ trợ từng kỹ năng tiếng Nhật như Từ vựng, Ngữ pháp, Kanji, hay Đọc hiểu và Nghe hiểu.

tiengnhatvn.com

Ba Tê · 10/12/20

NHN_Phương đã viết:
Xin chào các bạn,
OT copy một vùng dữ liệu từ Website về để vào trong cột B từ cột B này OT muốn chuyển dữ liệu sang thành dòng (như hình ảnh đính kèm bên dưới:

Bạn thử code này, máy tôi không có phông chữ này nên kết quả ra toàn chữ gì gì

PHP:

Option Explicit

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
    sArr = Range("B2", Range("B100000").End(xlUp).Offset(2)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
    For I = 1 To R - 2
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
        If sArr(I + 3, 1) = Empty Then
            dArr(K, 3) = sArr(I + 1, 1)
            dArr(K, 4) = sArr(I + 2, 1)
            I = I + 3
        Else
            dArr(K, 2) = sArr(I + 1, 1)
            dArr(K, 3) = sArr(I + 2, 1)
            dArr(K, 4) = sArr(I + 3, 1)
            I = I + 4
        End If
    Next I
    Range("D2").Resize(K, 4) = dArr
End Sub

Hoàng Nhật Phương · 10/12/20

Ba Tê đã viết:

Bạn thử code này, máy tôi không có phông chữ này nên kết quả ra toàn chữ gì gì

PHP:

Option Explicit

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
    sArr = Range("B2", Range("B100000").End(xlUp).Offset(2)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
    K = 1
    For I = 1 To R - 2
        dArr(K, 1) = sArr(I, 1)
        If sArr(I + 3, 1) = Empty Then
            dArr(K, 3) = sArr(I + 1, 1)
            dArr(K, 4) = sArr(I + 2, 1)
            I = I + 3
        Else
            dArr(K, 2) = sArr(I + 1, 1)
            dArr(K, 3) = sArr(I + 2, 1)
            dArr(K, 4) = sArr(I + 3, 1)
            I = I + 4
        End If
        K = K + 1
    Next I
    Range("D2").Resize(K, 4) = dArr
End Sub

Con chào Thầy ạ,
Cảm ơn Thầy đã luôn quan tâm và giúp đỡ con ạ.
Code đơn giản mà hiệu quả lắm Thầy ơi, con cảm ơn Thầy nhiều ạ.
------
À Thầy ơi, nếu mỗi từ ở các cột D,E,F,G con muốn x5 lần hoặc x10 lần (để chép đi chép lại cho thuộc từ) do vậy mà code của Thầy thêm thế nào cho hiệu quả ạ.
Còn để viết Sub riêng nữa con làm được Thầy ạ.
Con cảm ơn Thầy ạ, chúc Thầy nhiều sức khỏe ạ.

bomberman211 · 10/12/20

NHN_Phương đã viết:
Xin chào các bạn,
OT copy một vùng dữ liệu từ Website về để vào trong cột B từ cột B này OT muốn chuyển dữ liệu sang thành dòng (như hình ảnh đính kèm bên dưới:
View attachment 250949
Nhờ các bạn xem và giúp đỡ OT ạ.

Code hơi chuối cơ mà lỡ làm rồi cũng góp vui luôn

befaint · 10/12/20

Code bằng Python, ôm cả giao diện nên hơi nặng.

Điền url rồi ấn Download, kết quả là file text mở ra, Ctrl A-C, Ctrl + V vào Excel là được.

Link download

Hoàng Nhật Phương · 10/12/20

bomberman211 đã viết:
Code hơi chuối cơ mà lỡ làm rồi cũng góp vui luôn

OT cảm ơn bạn nhiều ạ.
----

befaint đã viết:
Code bằng Python, ôm cả giao diện nên hơi nặng.

Điền url rồi ấn Download, kết quả là file text mở ra, Ctrl A-C, Ctrl + V vào Excel là được.

Link download

View attachment 250953

Úi trời, nhìn hoành tráng quá à. Cảm ơn bạn nhiều befaint.

bomberman211 · 10/12/20

@befaint vị đại hiệp môn võ nào cũng biết hết vậy. Tại hạ bội phục, bội phục.

befaint · 10/12/20

bomberman211 đã viết:
@befaint vị đại hiệp môn võ nào cũng biết hết vậy. Tại hạ bội phục, bội phục.

Cái bang 1 túi nhá.

thuyyeu99 · 10/12/20

befaint đã viết:
Code bằng Python, ôm cả giao diện nên hơi nặng.

Điền url rồi ấn Download, kết quả là file text mở ra, Ctrl A-C, Ctrl + V vào Excel là được.

Link download

View attachment 250953

INTERNAL ERROR: cannot create temporary directory!

không thể tạo thư mực tạm

Nhattanktnn · 10/12/20

NHN_Phương đã viết:
À Thầy ơi, nếu mỗi từ ở các cột D,E,F,G con muốn x5 lần hoặc x10 lần (để chép đi chép lại cho thuộc từ) do vậy mà code của Thầy thêm thế nào cho hiệu quả ạ

Hoặc mình sửa tạm code thầy Ba Tê

Mã:

Option Explicit
Public Sub Gpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, J As Long
    sArr = Range("B2", Range("B100000").End(xlUp).Offset(2)).Value
    R = UBound(sArr)
    Const X As Long = 5
ReDim dArr(1 To Int(R * X / 4) + 1, 1 To 4)
    For I = 1 To R - 2
        If sArr(I + 3, 1) = Empty Then
            Do While J < X
                K = K + 1
                J = J + 1
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 3) = sArr(I + 1, 1)
                dArr(K, 4) = sArr(I + 2, 1)
            Loop
            I = I + 3
        Else
            Do While J < X
                K = K + 1
                J = J + 1
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 2) = sArr(I + 1, 1)
                dArr(K, 3) = sArr(I + 2, 1)
                dArr(K, 4) = sArr(I + 3, 1)
            Loop
            I = I + 4
        End If
        J = 0
    Next I
    Range("D2").Resize(Rows.Count - 1, 4).ClearContents
    Range("D2").Resize(K, 4) = dArr
End Sub

befaint · 10/12/20

thuyyeu99 đã viết:
INTERNAL ERROR: cannot create temporary directory!

không thể tạo thư mực tạm

Chắc không phải windows 10 rồi.

Nhattanktnn · 10/12/20

befaint đã viết:
Chắc không phải windows 10 rồi.

Em win10 chạy ổn, nhìn xịn sò phết, muốn học viết cái như này thì làm sao đây bác nhỉ

befaint · 10/12/20

Nhattanktnn đã viết:
Em win10 chạy ổn, nhìn xịn sò phết, muốn học viết cái như này thì làm sao đây bác nhỉ

Mình học Python thôi.

thuyyeu99 · 10/12/20

befaint đã viết:
Chắc không phải windows 10 rồi.

Kỳ vậy nhỉ, win mình win 10 64, mà máy ngày rồi không mở, nay mới mở lên dowload về là nó báo lỗi đó

befaint · 10/12/20

thuyyeu99 đã viết:
Kỳ vậy nhỉ, win mình win 10 64, mà máy ngày rồi không mở, nay mới mở lên dowload về là nó báo lỗi đó

Thế do Windows 10 đó thiết lập gì gì đó rồi.

ptm0412 · 10/12/20

NHN_Phương đã viết:
Nếu mỗi từ ở các cột D,E,F,G con muốn x5 lần hoặc x10 lần (để chép đi chép lại cho thuộc từ) do vậy mà code của Thầy thêm thế nào cho hiệu quả ạ.

Sửa code của @Ba Tê như sau, muốn lặp bao nhiêu lần thì sửa câu "s = 10"

PHP:

Sub GpeBate()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
Dim m As Long, n As Long, s As Long
    sArr = Range("B2", Range("B100000").End(xlUp).Offset(2)).Value
    R = UBound(sArr)
    s = 10
ReDim dArr(1 To R * s / 4, 1 To 5)
For m = 1 To s
    n = 0
    For I = 1 To R - 2
        K = K + 1
        n = n + 1
        dArr(K, 1) = sArr(I, 1)
        If sArr(I + 3, 1) = Empty Then
            dArr(K, 3) = sArr(I + 1, 1)
            dArr(K, 4) = sArr(I + 2, 1)
            dArr(K, 5) = n
            I = I + 3
        Else
            dArr(K, 2) = sArr(I + 1, 1)
            dArr(K, 3) = sArr(I + 2, 1)
            dArr(K, 4) = sArr(I + 3, 1)
            dArr(K, 5) = n
            I = I + 4
        End If
    Next I
Next m
    Range("D2").Resize(100000, 5).Clear
    Range("D2").Resize(K, 5) = dArr
    Range("D1").Resize(K, 5).Sort Key1:=[H1], Order1:=xlAscending, Header:=xlYes
    Range("H1").Resize(K, 1).Clear
End Sub

Hoàng Nhật Phương · 10/12/20

Nhattanktnn đã viết:

Hoặc mình sửa tạm code thầy Ba Tê

Mã:

Option Explicit
Public Sub Gpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, J As Long
    sArr = Range("B2", Range("B100000").End(xlUp).Offset(2)).Value
    R = UBound(sArr)
    Const X As Long = 5
ReDim dArr(1 To Int(R * X / 4) + 1, 1 To 4)
    For I = 1 To R - 2
        If sArr(I + 3, 1) = Empty Then
            Do While J < X
                K = K + 1
                J = J + 1
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 3) = sArr(I + 1, 1)
                dArr(K, 4) = sArr(I + 2, 1)
            Loop
            I = I + 3
        Else
            Do While J < X
                K = K + 1
                J = J + 1
                dArr(K, 1) = sArr(I, 1)
                dArr(K, 2) = sArr(I + 1, 1)
                dArr(K, 3) = sArr(I + 2, 1)
                dArr(K, 4) = sArr(I + 3, 1)
            Loop
            I = I + 4
        End If
        J = 0
    Next I
    Range("D2").Resize(Rows.Count - 1, 4).ClearContents
    Range("D2").Resize(K, 4) = dArr
End Sub

OT xin cảm ơn bạn nhiều ạ.

ptm0412 đã viết:

Sửa code của @Ba Tê như sau, muốn lặp bao nhiêu lần thì sửa câu "s = 10"

PHP:

Sub GpeBate()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
Dim m As Long, n As Long, s As Long
    sArr = Range("B2", Range("B100000").End(xlUp).Offset(2)).Value
    R = UBound(sArr)
    s = 10
ReDim dArr(1 To R * s / 4, 1 To 5)
For m = 1 To s
    n = 0
    For I = 1 To R - 2
        K = K + 1
        n = n + 1
        dArr(K, 1) = sArr(I, 1)
        If sArr(I + 3, 1) = Empty Then
            dArr(K, 3) = sArr(I + 1, 1)
            dArr(K, 4) = sArr(I + 2, 1)
            dArr(K, 5) = n
            I = I + 3
        Else
            dArr(K, 2) = sArr(I + 1, 1)
            dArr(K, 3) = sArr(I + 2, 1)
            dArr(K, 4) = sArr(I + 3, 1)
            dArr(K, 5) = n
            I = I + 4
        End If
    Next I
Next m
    Range("D2").Resize(100000, 5).Clear
    Range("D2").Resize(K, 5) = dArr
    Range("D1").Resize(K, 5).Sort Key1:=[H1], Order1:=xlAscending, Header:=xlYes
    Range("H1").Resize(K, 1).Clear
End Sub

Con cảm ơn chú Mỹ nhiều ạ.

ptm0412 · 10/12/20

NHN_Phương đã viết:
Con cảm ơn chú Mỹ nhiều ạ.

Bài này code không khó nhưng tôi thích code của anh @Ba Tê vì suy luận đơn giản ít nhức đầu. Do đó nếu sửa code đó tôi cũng muốn làm đơn giản và không nhức đầu giống vậy. Chứ bài 12 cũng sửa nhưng cứ như tôi thì suy luận quay cuồng cũng không hiểu tại sao dùng Do mà không dùng For next.

Học tiếng Nhật: tải bài từ web, sắp xếp, phát âm, dịch nghĩa

Thành viên gắn bó

File đính kèm

|||||||||||||

Thành viên gắn bó

Cạo Rồi Khỏi Gội

Thành viên gắn bó

***

File đính kèm

|||||||||||||

Thành viên gắn bó

***

|||||||||||||

Trùm Nhiều Chuyện

Thành viên gắn bó

|||||||||||||

Thành viên gắn bó

|||||||||||||

Trùm Nhiều Chuyện

|||||||||||||

Bad Excel Member

Thành viên gắn bó

Bad Excel Member

Facebook

Group