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

中學生 Rank: 2

帖子: 193
主題: 29
精華: 0
積分: 222
點名: 0
作業系統: Windows7
軟體版本: OFFICE2013
閱讀權限: 20
註冊時間: 2015-9-18
最後登錄: 2023-4-29

24^#

發表於 2017-8-27 04:16 | 只看該作者

回復 20# 准提部林

板大 , 我想再請教一個問題
這些資料條件都是在連續性的情況下
假設我如果當中資料有不定時空白的資料, 如何處理呢? 如下圖

我目前發現只要有空白的他就會自動結束迴圈

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

23^#

發表於 2017-8-9 20:18 | 只看該作者

回復 22# v03586

我的office版本無法正常執行程式,
應該幫不上!!!

TOP

v03586

中學生 Rank: 2

帖子: 193
主題: 29
精華: 0
積分: 222
點名: 0
作業系統: Windows7
軟體版本: OFFICE2013
閱讀權限: 20
註冊時間: 2015-9-18
最後登錄: 2023-4-29

22^#

發表於 2017-8-9 15:30 | 只看該作者

本帖最後由 v03586 於 2017-8-9 15:31 編輯

回復 20# 准提部林

感謝板大提供的兩個版本!!! 最後我選擇有合併格的 !!!
可否再請教大大一個問題...

在我Test report的EXCEL "機台數"的分頁, 去做一個類似分析資料, 因為我知道樞紐分析用錄製的
   只要他的參考資料有新增沒有被錄製進去的資訊就會跳出錯誤

    程式步驟是, 開啟Test Report 再打開"參考資料" →  再按產生報表
   程式會從參考資料抓取要的資料到Test report 去做資料彙整
   直到Moudle3『機台數』只是把參考資料中我要的資料抓過來, 再做一個篩選
   剩下的資料要做分析的
   Q1:  能否將Moudle3 篩選完的資料在同一個分頁『機台數』呈現出  上圖的資料呢?
            如果PKG是空白代表機台待料, 可否把空白字眼換成" 待料 "

Ｑ2: 能否將分析完的資料再匯入FMC 與 ENG 的資料表內

比對每一欄的J欄的PKG 如果相符就把分析完的機台數帶入F欄位

test2.rar (750.09 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

21^#

發表於 2017-8-6 20:07 | 只看該作者

回復 19# v03586

Sub test1()
Dim R, xR As Range, xH As Range
R = [D65536].End(xlUp).Row
For Each xR In Range([D2], [D65536].End(xlUp))
　　If xH Is Nothing Then Set xH = Cells(xR.Row, "AD")
　　If xR(2) <> xR Then
　　　With Range(xR(1, -2), xH)
　　　　　　.Borders.Weight = 4
　　　　　　If .Columns.Count > 1 Then .Borders(11).Weight = 2
　　　　　　If .Rows.Count > 1 Then .Borders(12).Weight = 2
　　　End With
　　　Set xH = Cells(xR.Row + 1, "AD")
　　End If
Next
End Sub

只適用于無合併格！！！
　

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

20^#

發表於 2017-8-6 20:01 | 只看該作者

回復 19# v03586

Sub test()
Dim R, xR As Range, xH As Range, xE As Range, i&, V&
R = [D65536].End(xlUp).Row
For i = 2 To R
　　Set xR = Cells(i, "D")
　　If xH Is Nothing Then Set xH = Cells(i, "AD")
　　V = xR.MergeArea.Rows.Count
　　Set xE = xR(V)
　　If xR <> xE(2) Then
　　　　With Range(Cells(xE.Row, 1), xH)
　　　　　　　.Borders.Weight = 4
　　　　　　　If .Columns.Count > 1 Then .Borders(11).Weight = 2
　　　　　　　If .Rows.Count > 1 Then .Borders(12).Weight = 2
　　　　End With
　　　　Set xH = Cells(i + V, "AD")
　　End If
　　i = i + V - 1
Next i
End Sub

不管Ｄ欄有沒有合併格，都可以！！
　
　

TOP

v03586

中學生 Rank: 2

帖子: 193
主題: 29
精華: 0
積分: 222
點名: 0
作業系統: Windows7
軟體版本: OFFICE2013
閱讀權限: 20
註冊時間: 2015-9-18
最後登錄: 2023-4-29

19^#

發表於 2017-8-6 17:45 | 只看該作者

回復 18# 准提部林

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

TEST2.rar (65.2 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

18^#

發表於 2017-8-6 17:08 | 只看該作者

回復 17# v03586

有合併格？？？
上傳檔案再看看！！！
　

TOP

v03586

中學生 Rank: 2

帖子: 193
主題: 29
精華: 0
積分: 222
點名: 0
作業系統: Windows7
軟體版本: OFFICE2013
閱讀權限: 20
註冊時間: 2015-9-18
最後登錄: 2023-4-29

17^#

發表於 2017-8-6 15:43 | 只看該作者

回復 16# 准提部林

請問一下大大, 修改後判斷式為D欄位只要有一樣的話細線, 不一樣的畫粗線來做分別
但是我的判斷一樣使用D欄位, 但話線的範圍要擴大A2欄位到AD2以下的欄位都要話線 , 請問要如何延伸呢?
判斷式一樣是由D欄位

Dim xxR As Range, xxH As Range
For Each xxR In Range([D2], [D65536].End(xlUp))
If xxR.Row < 2 Then Exit Sub
If xxH Is Nothing Then Set xxH = xxR
If xxR(2) <> xxR Then
With Range(xxR, xxH)
.Borders.Weight = 4
If .Count > 1 Then .Borders(12).Weight = 2
End With
Set xxH = xxR(2)
End If
Next

複製代碼

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-21

16^#

發表於 2017-8-6 09:13 | 只看該作者

本帖最後由准提部林於 2017-8-6 09:17 編輯

回復 15# v03586

For Each xR In Range([D2], [D65536].End(xlUp))
　　If xR.Row < 2 Then Exit Sub '當D2以下為空時,結束程序
　　或　If xR.Row < 2 Then Exit For '當D2以下為空時,跳出迴圈
　
Next

TOP