12
返回列表 上一主題 發帖

[發問] 資料剖析+加框線

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2017-7-29 06:26 | 顯示全部帖子

[發問] 資料剖析+加框線

請問各位高手大大, 如何將這段功能轉為程式碼
1.  有點類似資料剖析的概念, 因為格式不一定 , 但規則確定的是刪除從左邊數過來兩個『-』
     保留紅色的字體

2.  畫線後判斷不同的加粗體分辨





TEST.rar (8.18 KB)
收藏 分享

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
2#
發表於 2017-7-29 09:32 | 顯示全部帖子
[版主管理留言]
  • GBKEE(2017/7/29 10:02): 2#程式碼已更新 , 再試試看

本帖最後由 v03586 於 2017-7-29 09:37 編輯

回復 2# GBKEE


    感謝版大的支援,
    想問一下, 他的末碼規則不一定是QQP 的話, 也可能是別的AAP 之類的 , 不固定, 是還要在加一串
  1. For i = 0 To UBound(sp) - IIf(InStr(E, "QQP"), 2, 1) and UBound(sp) - IIf(InStr(E, "AAP"), 2, 1)
複製代碼
這樣嗎?? 確定固定規則模式從左邊數來兩個『-』是要刪除的

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
3#
發表於 2017-7-29 10:26 | 顯示全部帖子
本帖最後由 v03586 於 2017-7-29 10:28 編輯

回復 2# GBKEE


    板大加入了末碼規則後, 程式跑完變成 只保留末碼, 『AAP , QQP 』
    不是變成保留像圖片中保留紅色字體部分 QQ
    我按F8 去跑  會變成下面這段 把他變成 AAP , QQP
  1. For i = 0 To UBound(sp) - IIf(Msg, 2, 1)
  2.                 E = Replace(E, sp(i) & "-", "")
  3.                 'Replace 函數 傳回一個字串 , 該字串中指定的子字串已被取代成另一子字串, 並且取代發生的次數也是指定的
  4.             Next
複製代碼

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
4#
發表於 2017-7-29 12:46 | 顯示全部帖子
本帖最後由 v03586 於 2017-7-29 12:56 編輯

回復 5# GBKEE

   如圖片說明 , 唯一找的到不變的規則, 就是從左邊往右算兩個『-』 不保留
    如果從右邊算, 有的會有末碼QQP 等字碼
    Q2.png

     有的字串會有三個『-』  e.g.
     XX-XXXX-XXXX-QQP
     有的字串只有兩個『-』 e.g.
    XX-XXXX-XXXX
    要保留的 依循有效規律規則, 從左邊往右算2個『-』


TEST.rar (16.76 KB)

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
5#
發表於 2017-8-4 04:51 | 顯示全部帖子
回復 7# GBKEE


    感謝板大的協助
  第九行這一段
  1. If UBound(sp) >= 2 Then
複製代碼
改成這一段就可以完成了 !!! 再次感謝~~

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
6#
發表於 2017-8-4 04:55 | 顯示全部帖子
回復  v03586
Hsieh 發表於 2017-8-2 14:53



    感謝板大的提供另一種方式, 對於畫線的方式, 又學到一招板大的方式撰寫

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
7#
發表於 2017-8-4 12:10 | 顯示全部帖子
回復 8# Kubi


    感謝大大的提供 !!

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
8#
發表於 2017-8-5 23:46 | 顯示全部帖子
回復 14# 准提部林

請問一下, 我有依照我的額外需求做了一些小修改, 想請問一下
如果我要判斷畫線的資料欄位在D欄位 ,  我如何修改讓他算整筆資料的最後一欄 ??
是加入下面這一段嗎???
  1. .Range("D65536").End(xlUp).Row To 2 Step -1
複製代碼
再來我要畫線的範圍是A2欄到AD2欄
  1. Dim xR As Range, xH As Range
  2. For Each xR In [D2:D3000]
  3.     If xH Is Nothing Then Set xH = xR
  4.     If xR(2) <> xR Then
  5.         With Range(xR, xH)
  6.               .Borders.Weight = 4
  7.               If .Count > 1 Then .Borders(12).Weight = 2
  8.         End With
  9.         Set xH = xR(2)
  10.     End If
  11. Next
複製代碼

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
9#
發表於 2017-8-6 15:43 | 顯示全部帖子
回復 16# 准提部林

請問一下大大, 修改後判斷式為D欄位只要有一樣的話細線, 不一樣的畫粗線來做分別
但是我的判斷一樣使用D欄位, 但話線的範圍要擴大A2欄位到AD2以下的欄位都要話線 , 請問要如何延伸呢?
判斷式一樣是由D欄位
  1. Dim xxR As Range, xxH As Range
  2. For Each xxR In Range([D2], [D65536].End(xlUp))
  3.     If xxR.Row < 2 Then Exit Sub
  4.     If xxH Is Nothing Then Set xxH = xxR
  5.     If xxR(2) <> xxR Then
  6.         With Range(xxR, xxH)
  7.               .Borders.Weight = 4
  8.               If .Count > 1 Then .Borders(12).Weight = 2
  9.         End With
  10.         Set xxH = xxR(2)
  11.     End If
  12. Next
複製代碼

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
10#
發表於 2017-8-6 17:45 | 顯示全部帖子
回復 18# 准提部林


    抱歉, 沒有合併格, 合併格是我處理完畫線才合併格的 !!!


TEST2.rar (65.2 KB)

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
12
返回列表 上一主題